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ABSTRACT 


This report summarizes the progress of applied research conducted under 
NASA Grant NSG-1650 during the period March 1, 1982 to September 30, 1982, 
The objective of this project is to investigate the applicability of spec- 
tral assignment techniques to the design of multivariable feedback control . 
systems. A fractional representation design procedure for unstable plants 
is presented and illustrated with an example. Then, a computer aided design 
software package implementing eigepvalue/eigenvector design procedures is 
described. A design example which illustrates the use of the program is 
explained. 
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DESIGN OF MULTIVARIABLE FEEDBACK CONTROL SYSTEMS VIA 
SPECTRAL ASSIGNMENT 

By 

Roland ft. Mielke* , Leonard J. Tung 2 and Mohaen Mare fat 3 

1. INTRODUCTION 

This report summarizes the progress of applied research conducted under 
NASA Grant NSG-1650 for the period March 1, 1982 to September 30, 1982. The 
objective of this work is to investigate the applicability of spectral 
assignment techniques to the design of multivariable feedback control 
systems. 

First, development of new frequency domain fractional representation 
design procedures for unstable plants is presented. The procedure consists 
of a technique for searching among all stabilizing controllers for those, 
that also satisfy certain design specifications. Controller complexity and 
hidden system modes are considered. The procedure is illustrated with a 
design example. Then a new computer aided design software package imple- 
menting the time domain eigenvalue/eigenvector assignment procedures is 
described. The Use of the program is illustrated with a design example. 

The program listing is included in the Appendix. 

2. FRACTIONAL REPRESENTATION DESIGN PROCEDURES 
2.1. Introduction 

Our investigation in the area of frequency-domain controller design 
began with a study of the work by Youla and others (refs. 1,2). Among the 
many contributions in Youla's work is a procedure which leads to the 
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characterization of a general class of stabilizing compensators for a plant 
imbedded in a single-loop feedback control system. This procedure has then 
been generalized by Desoer and others (ref. 3) to form the basis of the so- 
called fractional representation approach. This approach offers a system- 
atic procedure for constructing stabilizing compensators that achieve other 
design objectives such as decoupling the outputs and tracking step inputs. 

It should be noted that the objective of stabilization is resolved before 
other design objectives. In contrast to this type of approach is the work 
by Sain and others (refs. 4,5). Sain's work develops a direct method for 
the construction of compensators for a plant imbedded in a unity feedback 
control aystem. In this method, compensators that achieve design objectives 
such as decoupling are first constructed and then the issue of stabilization 
is resolved. Combining the results by Desoer and by Sain, we have developed 
design procedures that simultaneously achieve the design objectives of stab- 
ilization, decoupling, and tracking step inputs. Ihese design procedures 
are expressed so that it is relatively easy to address the problems of com- 
plex compensators and unwanted hidden modes as noted in references 5 - 7 . 

In this report, we begin with a brief review of the fractional repre- 
sentation approach. After the review we outline two sets of procedures, one 
for stable plants and one for unstable plants, for constructing compensators 
that achieve design objectives of stabilization, decoupling, and tracking 
step inputs. These design procedures also allow us to construct simple 
compensators C * -P -1 T(I-T) -1 for a given plant P by choosing simple 
stable diagonal T which satisfies certain requirements. The details of 
the procedures are exemplified by a problem of compensator design for an 
unstable plant. Finally, the problem of hidden modes is dealt with by care- 
fully choosing the zeros of I-T. 

2.2. Compensator Design 

Consider the single feedback loop multivariable control system shown in 
figure 1. With the plant P(s) (a proper rational matrix) given, it is 
desired to design a controller C(s) (another proper rational matrix) for 
stabilization, decoupling and tracking step inputs. The fractional 
representation approach (refs. 3,8,9) offers a systematic procedure for 


achieving these design objectives. In this approach, the plant is expressed 
in a right and a left coprime exponential stable rational fractional 
descriptions, P ■ N r D" 1 * with U r , V r » and such that U r N r + 

V r D r * ■ I. Note that all terms except possibly the plant P 

are proper rational matrices with poles in the open left-half complex plane. 
With these descriptions for P, a {general class of stabilizing controllers 
is given by 

C - (WN, +V )" 1 (-WD +U ) , ( 1) 

r it 

where W can be any proper exponential stable rational matrix as long as 
WNg + V r is nonsingular. With this class of controllers, the cloiled-loop 

transfer function is given by 

T - N [ -WD„ +U ]. (2) 

r L l r J 

When P itself is exponential stable, we can have N ■ N. ■ P, D « D. ■ 

r , % r Jt 

I, ■ 0 and V ■ * I. Equations (1) and (2) then become 

C - - Wn+PW]" 1 (3) 


and 


T = - PW, (4) 

Equations (1) through (4) display the freedom in choosing a stabilizing 
controller as the freedom in choosing W. This freedom in choosing W can 
then be explored for achieving other design objectives such as decoupling 
and tracking. For decoupling, T is to be made diagonal. For tracking 
step inputs, every term in I-T should have a zero at s ■ 0. 
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Figure 1. Multivariable feedback control systems. 


Stable Plants 

First assume that P is exponential stable and invertible. Under this 
assumption, T * -PW is invertible if W is invertible. The invertibility 
of T is important because it eliminates the possibility of zero diagonal 
terms in T after T is made diagonal for decoupling, a case which indi- 
cates redundancy of certain input and output signals. For maintaining the 
stability of the closed-loop system, our approach is to choose stable T to 
make W * -P"*T stable. For decoupling, we only have to work with diagonal 
T. For tracking step inputs, we must choose among those matrices T such 
that all terms in I-T have a zero at s * 0. For constructing controllers 
that simultaneously achieve stabilization, decoupling and tracking step 
inputs, we thus have the following procedures: 

(i) For decoupling, choose T * diag {Tj,...,T n }. 

(ii) Let P" 1 ■ [P i, . , , ,P n ], where P^ is the ith column of P“ l . We 
than have P _1 T * [PiTj, . . . ,P T J. For maintaining the stability, each 
and each P.T. should be proper. Poles of T £ should be in the open 
left-half complex plane. Zeros of T. must cancel the closed right-half 
plane poles of P^. 

(iii) Let T. * n./d,. For tracking step inputs, each (d. - n.) should 

XXX XX 

have a zero at a ■ 0, i.e. no constant term. 

(iv) C ■ -P”*T( I-T)" 1 . 


4 





'-T*"*** 




ORIGINAL PAGE 18! 

Unstable Plants Qp pooft QUALITY 

For unstable plants, similar design procedures can be derived. Again, 

we are interested in invertible matrices T. This requires the assumption 

that P is invertible, which in turn implies that N and N f are invertible. 

As before, we use diagonal T for decoupl ing‘ and we choose those matrices 

T such that all terms in I-T have a zero at s ■ 0 for tracking step 

inputs. For stabilization, however, we choose stable T to make W ■ (-N“*T 

+ U jDr 1 stable. This process is more involved than the corresponding 
r * , 
process for stable plants. The reason for this is that may be 

unstable for a given unstable plant. In order to achieve stability, somehow 

part of N" 1 TD" 1 is to be made unstable to cancel the unstable part of 
r X 

U . With this in mind, we have the following design procedures for 
constructing controllers that simultaneously achieve stabilization, 
decoupling and tracking of step inputs: 

(i) For decoupling, choose T * diag {Tj,. . .,T n } 


(ii) Find a stable T Q . diag {T 0 i , . . . ,T 0n } 
-1 -1 

to make - N 1* D„ + U Dr* stable 
r ^ A r A 


(iii) Let T - diag {T T > , if 1 - [Si , . . . ,N ] 

s si sn r L n J 


and D. 


-1 


M "1 ft* , 

, where N. is the ith column of N and D. is 
l r j 


-1 


the jth row of . We then have 
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For achieving stability, each T . and N.T .D. should be proper. Poles 

• Mm 1 B 1 JL 

of T # ^ should be in the open left-half complex plane. Zeros of must 

cancel the closed right-half plane poles of and D^. 


(iv) Let T , 
ox 


n . /d . and 
ox 01 


T . 

SX 


h ./d 

ax 


• • 
sx 


For tracking step inputs, each (d # £<| . “ n g i d 0 i “ n oi d si^ 
should have a aero at s ■ 0, i.e. no constant term. 


( v) T ■ T + T , and 

O 8 

C - - PT(I-T)- 1 . 

2.3. Complexity of Controllers 

As pointed out earlier, the fractional representation approach allows 
us to search systematically for compensators that achieve various design 
objectives. This approach, however, does not always bring about simple 
compensators, As a matter of fact, the time-domain dynamic compensation 
(ref. 10) is more likely to bring about simple stabilizing compensators than 
the fractional representation approach. On the other hand, the fractional 
representation approach is more likely to result in simple stabilizing 
compensators that also decouple system outputs. Hie latter is due to the 
difficulty in dynamic compensation of relating directly the diagonality of a 
transfer fraction to the formation of the system matrices {A,B,C,D} in the 
state-space description of a system. 

In our design procedures, the compensator C is given by C ■ -P“* 
T(I-T) -1 . For a given plant P, T is to be chosen for forming compensa- 
tors that stabilize the system, decouple the outputs as well as track step 
inputs. Under close examination, we notice that the poles of T will basi- 
cally be cancelled by the same poles of (I - T) in forming C. These poles 
do not directly affect the complexity of the controllers. However, the 
total number of the poles determines the degree of freedom in choosing the 


6 


zeros of T and I-T. For simple compensators, the zeros o£ T can be 
chosen to cancel the poles of P” 1 , and zeros of 1-T sen be chosen to 
cancel the zeros of P - * * Overall, T should be kept as simple as 
possible. The following problem illustrates the details involved. This 
problem was first discussed in references 6 and 7. 


2.4. Design Example 


For a plant 
P(s) 


1 s-1 

8+1 S+l 

0 i^rj 


We have derived a set of stable matrices N„, D . N, , D s , V., V., U. and 
l given by 


D r “ D t “ 


N t “ 


1 0 


P 

1 

M 

(s-l) 2 

8-1 

* N r “ 

8+1 

(s+i)(s+2) 

1 

0 s+2 


0 

s+2 

.n 


-1 

. 


1 8-1 
s+1 S+l 

1 

0 s+2 


V_ - 


Since 


n [l zlil 

• vt ’lo *; 

-i r° ° l 

U rV " 3 U+ 2 ) 

L° 8 ' 1 J 


is not stable, a simple stable T Q is to be found to make 

-«;vr l ♦ m ? 1 


8 table* Such a T Q is given by 
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-i -i 1° °1 

-N T D, + U D, - 
r °t tl [o 3j 
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We then study 


-1 -1 
"Wit " 


-T .(s+l) T „(s+2)(s+l) 
si s2 


-T 


s2' 


( s+2) 2 

8-1 


In order to make this term stable, we must have the following 


1. Let ■ n s i/^ s j» 30 t * iat 


deg (n g j) + 1 < deg (d g j). 


2. Let T ■ n _/d n , so that 
82 s2 s2 


deg (<* c2 ) + 2 < deg (d g2 );, 


3. Zevai of d , and d are in the open LHP. 

Sf oz 


4. Zeros of ti , contain s ■ 1. 
si 


Based on points 1 through 4, we have the simplest 


T - a/(s+b) 
8 i 


and the simplest 


T g2 » c(s-l)/(s+2) 2 (s+d), 


with positive b end d. For tracking step inputs, both 1 - 


■ nd l ' T o2 


T s2 must have a zero at s • 0. This reguires that b 


a ■ 


0 and Ad - 9d + c ■ 0. It can be seen that there are many solutions for 
a, b, c and d. Two sets of solutions are given below, together with She 
corresponding closed-loop transfer functions and compensators. Choosing 
b ■ 1 and d ■ l, we have a ■ 1, c ■ 5 and 


T ■ T + T 

o s 


1 0 
s+T 

14s + 4 


0 <s+2) 2 <s+l) 


s+l -(14s+4)(s-l ) 

s s(s+6) 

14s + 4 
0 s(s+6) 


* aNW - In iS 
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Choosing b “ i and d ■ 3, we have a ■ 1, c ■ 15 and 

1 0 
s+l 

T w 

24s + 12 
0 (s+2) 2 (s+3) 


s+l -3 (8s+4)(s-l) 
s sTs+ll — 

3(8s+4) 
o ’sTs+57 


2.5. Hidden Modes 

It is known that feedback design using transfer functions may bring 
about unwanted stable modes hidden in the closed-loop system (ref. 5). In 
the example of the previous section, the closed-loop system has a transfer 
function T(s) that corresponds to a fourth order system. However, tfc.i 
plant P is a second order system and the compensator C is a third order 


9 


system which means that the closed-loop system is actually a fifth order 
system. The difference in the order of the closed-loop system and its 
transfer function suggests that there is a hidden mode. The hidden mode in 
the example is at i ■ -1 which has resulted from the cancellation of the 
pole of P and the zero of C at s ■ -1. To prevent this type of cancel- 
lation, zeros of I - T should be chosen to match the stable poles of P 
(which are zeros of P~* ) in forming C. This selection may prevent us from 
choosing the simplest T in our design procedures. However, this should 
not be considered as a setback for finding the simplest compensators, but 
rather a procedure that guarantees the correct representation of a closed- 
loop system by its transfer function. With this procedure, the design in 

the example of the previous section is modified as follows. 

The stable pole of P is at s ■ -1. This pole appears in the (1,1) 
element of P” 1 as a zero. Hence, I-T. ■ T . ■ I - T . should have a 

zero at s ■ -1 in addition to the zero at s ■ 0 required for tracking 

step inputs. This requires that deg(d # j) > 2. The simplest T g j that has 

this property is i.f the form 

ORIGINAL PAGE IS 
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81 (s+a) (s+b) 

with a and b > 0. We must have 

^ j m s 2 + (a+b)s + ab - cs - d m s(s+l) 

(s+a) (s+b) (s+a) (s+b) 

That means a + b - c * 1 and ab - d ■ 0. Again, there are many solutions 

for a, b, c and d. Choosing * » 3 and b "4, we have c ■ 6, d * 

12 and 

m 6s+12 

X m - - - - - 

81 (s+3) (s+4) 

Using a set of T^ and T^ as before, we have 
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6(s+2) 

(s+3)(«+4) 


0 


T - 


24g+12 
( 8 + 2 ) 2 ( 8 + 3 ) 
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and 


C 


(s) 


6(8+2) - (248+12 )( st- 1) 

8 518+37 

24s + 12 

0 s(s+8) 


Note that C remains a third order system and the order of T^j is 5 
which means that there is no longer a hidden mode. 


3. EIGENVALUE/EIGENVECTOR ASSIGNMENT PROCEDURES 


3.1. Introduction 

The design of multivariable feedback control systems using eigenvalue/- 
eigenvector assignment procedures has received considerable attention during 
the past several years. Several early studies (refs. 11, 12) focused on an 
algebraic formulation of the spectral assignment problem. More recent 
studies (refs. 13-15) have been successful in developing a geometric formul- 
ation of this problem. In (ref. 13) the total design freedom available to 
assign eigenvectors is characterized in terms of eigenspaces. The use of 
this freedom to achieve desired design specifications has been the subject 
of an extensive investigation by the current authors and colleagues. 

Procedures have been developed for approximating desired mode mixing 
(ref. 16), reducing eigensystem sensitivity to variations in plant parame- 
ters (refs. 17, 18), and reducing the effects of actuator noise on a statis- 
tical measure of system performance (ref. 19, 20). In addition, a procedure 
for modifying the feedback gain matrix to satisfy specified gain constraints 
(ref. 21, 22) while maintaining a given mode mix has been devised. More 
recently these procedures have been combined into a single unified design 
philosophy (ref. 7) . This philosophy is reviewed and a computer aided 
design software package to implement the design philosophy is presented in 
this section. 


11 


3.2. Design Philosophy 


The new eigenvalue/eigenvector assignment design philosophy is illus- 
trated in figure 2. The philosophy is based on the premise that achieving a 
specified set of eigenvalues and approximating a desired set of eigenvectors 
is of primary importance. Sensitivity reduction, noise suppression, and 
gain modification are assigned secondary importance and are carried out so 
as to preserve an initial spectral assignment. 

The procedure assumes that the designer is able to identify a desired 
set of eigenvalues and an approximate set of desired eigenvectors. Eigen- 
values directly control the rates of response of the system modes while 
eigenvectors control how the modes mix among the system states and/or out- 
puts. The design begins with the specification of a desired set of eigen- 
values, The procedure realizes arbitrarily specified sets of eigenvalues if 
the system is controllable. The specified eigenvalues are used to compute 
the system eigenspaces — the vector spaces in which all realizable system 
eigenvectors must be contained. These spaces explicitly display the total 
design freedom available in assigning eigenvectors for a given eigenvalue 
assignment. Next, the desired set of eigenvectors are specified and pro- 
jected onto the eigenspaces to locate the set of realizable eigenvectors as 
close as possible in a minimum square error sense to the desired set of 
eigenvectors. Since the major advantage of the eigenvalue/eigenvector 
assignment procedure is the ability to assign eigenvectors, great importance 
is given to remaining in a small neighborhood of the initial eigenvector 
assignment. 

After the specified eigenvalues have been assigned and the specified 
eigenvectors have been approximated, the resultant closed-loop system is 
investigated to determine if all eigenvector components are satisfactory, 
eigensystem sensitivity is sufficiently low, and gain magnitudes meet speci- 
fied design constraints. If modification is requried, new eigenvectors are 
selected in a manner to achieve the desired objective using a gradient 
search procedure. However, the gradient search is conducted local to the 
initial eigenvector assignment so that desired mode mixing is retained. 
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Figure 2. Eigenvalue/eigenvector assignment design philosophy. 



3.3. Computer Aided Design Software Package 

A flowchart diagram illustrating the organization of the computer soft- 
ware package to implement the eigenvalue/eigenvector assignment procedure is 
shown in figure 3. The package consists of a number of special purpose 
subprograms accessible from a main control program. The subprograms can be 
called in any order to implement specific design objectives, as shown in 
figure 2. The program is self-instructed and requires no familiarity on the 
part of the user with the mathematics of spectral assignment. 

In the following, the various modes of operation of the program are 
discussed. An example illustrating the use of the program is presented in 
the next section, and the program listing is included in the Appendix. 

Mode 0 

Mode 0 provides a list of references detailing progran operation. 

Mode 1 

Mode 1 is the mode in which system data is entered to the program. 
Required data includes the number of system states, inputs, and outputs, and 
the system state variable description in matrix form given by the triple (A, 
B, C). The user can also set the number of significant digits in user- 
computer communication as well as. the program value for "zero." 

Mode 2 

In Mode 2, the user specifies desired closed loop system eigenvalues. 
This mode then internally calculates the corresponding eigenspaces for 
transmission to other subprograms. User selected eigenvalues are always 
achieved in this desgin procedure. 

Mode 3 

The user specifies desired eigenvectors in Mode 3. The program 
responds with the set of actual closed loop system eigenvectors which are 
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Figure 3. Spectral assignment computer software package organization, 
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closest to those specified in a least square error sense. The program also 
displays the error magnitude between each desired and realized 
eigenvector. 

Mode 4 

Mode 4 is a closed loop system simulation package. The subprogram 
mmerically solves the set of system state equations subject to user 
specified inputs and initial conditions. Time responses are plotted 
separately or on the same axes for comparison. 

Mode 5 

Mode 5 allows the user to modify specified components in the 
eigenvector matrix while retaining current values of other components The 
modification is automatically carried out using a gradient search procedure 
under the control of the user. 

Mode 6 

Mode 6 allows the user to modify selected components of the feedback 
gain matrix while maintaining an approximation to a specified eigenvector 
matrix. Components of the feedback matrix to be reduced are identified by 
row and column number. Unequal priority in reducing component magnitudes 
can be assigned. The modification is automatically conducted by a gradient 
search algorithm under the control of the user. 

Mode 7 

In Mode 7 the user can reduce eigen, system sensitivity to variations in 
plant parameters. The procedure utilizes a gradient search procedure to 
modify system closed loop eigenvectors to reduce the sensitivity of 
eignevalues and eigenvectors to changes in specified components of the 
system state matrices. 
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3.4. Design Example 


In this section an example is presented to illustrate the designer - 
machine dialog during the design process. Made 1 is £irst entered and 
important system data is input. 


Number of states: 3 

Number of inputs: 2 

Number of outputs: 3 

Significant digits: 6 

Progran zero: 0.0001 


ORIGINAL PAGE IS 
OF POOR QUALITY 



-2.00 

0.00 

1.00 

A - 

0.00 

-2.00 

1.00 


1.00 

m 

1.00 

-2.00 


B 


1.00 

0.00 

0.00 

1.00 

0.00 

0.00 


C 


1.00 0.00 0.00 

0.00 1.00 0.00 

0.00 0.00 1.00 


Next Mode 2 is entered and desired closed-loop system eigenvalues are input. 


Ai - -1.00 
\Z - - 1.20 

*3 “ "3.00 
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If 


Mode 3 is entered next and desired closed- loop system eigenvectors are 
input* The program responds with the actual set of eigenvectors as close as 
possible in a least square error sense to those specified. The program also 
generates the feedback matrix F which assign these eigenvectors and the 
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specified eigenvalues. 




3.75 

-0.67 

1.00 

V . . . - 

3.25 

0.75 

-1.00 

desired 

7.00 

0.00 

0.10 

«H 


3.75 

-0.70 

0.97" 

V , - 

3.25 

0.72 

-1.03 

actual 

7.00 

0.02 

0.07 

m 


f 13.25 

12.53 

-13.38" 

[-13.16 

-12.45 

12. 30_ 


The designer then enters Mode 4 to simulate the closed-loop system just 
designed. The user specifies initial conditions and system inputs. 



, . fo.ool 
" (t) ■ [i.ooj 


The program responds with plots of the system inputs and states shewn as 

I 

j functions of time. Plot are also shown for another set of initial 

1 

j conditions and zero input. 

J 

j 

4 
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,It is demonstrated that curves may be requested separately or together for 
comparison. The designer next enters Mode 5 to modify a component of the 
eigenvector matrix. The designer specifies that he desires to reduce the 
magnitude of the (3,1) element of V. Equal weight is assigned to reducing 
this component and to retaining the current values of other components. 

After three iterations, a satisfatory V is obtained. The program displays 
the new feedback gain matrix for this assignment. 


r 3. is 

-0.70 

0.971 

2.68 

0.72 

-1.03 

L 5. 85 

0.02 

0.07 J 

[ 13.25 

12.54 

-13.38*1 

1-13.16 

-12.45 

12. 29 J 


The designer then returns to Mode 4 to again display the system states, 



Finally, the designer enters Mode 6 to attempt to reduce the magnitudes of 
entries in the gain matrix without greatly changing the eigenvector assign- 
ment. Equal weight is placed on reducing each component of F. After three 
iterations a new V matrix and corresponding F matrix are obtained. 
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3.18 

-0.66 

0.751 

2.68 

0.76 

-1.24 

5.85 

0.16 

0.48 J 

2.21 

1.44 

-2.31*1 

2.12 

-1.41 

1.25 I 


Not demonstrated here but included in the program is a sensitivity reduction 
mode. The progrmn is also fully capable of dealing with complex eigenvalue 
and eigenvector assignments. 
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************************************************] ********************** 
********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 

ENTER DESIRED MODE OP OPERATION# MODE-OfI »2» . . . ,Bi 

1 

******* ******************* MODE It DATA ENTRY ************************* 
**«*«*****ENTER OR CHANGE SYSTEM PARAMETERS: 


PREVIOUS VALUES? 
1 

NS* 3 

NX- 2 

NO- 3 1DGT- 6 

UISH TO CHANGE? 
0 

MATRIX A : 

1 

2 

3 

1 -0. 200000E+01 

O.OOOOOOE+OO 

0. 100000E+01 

2 O.OOOOOOE+OO 

-0 • 200000E+0 1 

0.100000E+01 

3 0.100000E+01 

0. 100000E+01 

-0.200000E+01 

WISH TO CHANGE? 
0 

MATRIX B : 

1 

2 



ZERO* O.OOOOIOOOOOOO 


ORIGINAL PAGE IS 

OF POOR QUALITY 


1 0. 10000DE+01 O.OOOOOOE+OO 

2 O.OOOOOOE+OO O.OOOOOOE+OO 


3 O.OOOOOOE+OO 
UISH TO CHANGE? 

1 

ENTER NEW VALUE(S) : 
1.000 0.000 
0.000 1.000 
0.000 0.000 
MATRIX C t 

1 


O.OOOOOOE+OO 


* 

2 3 


1 0. 100000E+01 O.OOOOOOE+OO O.OOOOOOE+OO 

2 0 . 100000E+01 O.OOOOOOE+OO O.OOOOOOE+OO 

3 O.OOOOOOE+OO 0. 100000E+01 0.100000E+01 

WISH TO CHANGE? 

1 

ENTER NEW VALUE <S) J 

1.000 0.000 0.000 

0.000 1.000 0.000 

0.000 0.000 1.000 

UISH TO EXIT FROM THIS MODE? 

1 

*************************** EXITING MODE 1 ************************* 

TERMINATE THIS RUN OR SELECT NEXT MODE: 


WISH TO TERMINATE? 

O 

********************************************************************** 
********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 
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ENTER DESIRED MODE OF OPERATION »HODE«Or l,2t » , ♦ >8t 


ORIGINAL PAGE IS ' 
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******************** MODE 2 {EIGENVALUE ASSIGNMENT ******************** 
********** ENTER OR CHANGE EIGENVALUES: 


PREVIOUS VALUES? 

0 

LAMBDA It 

REAL* O.OOOOOOE+OO I MAG* O.OOOOOOE+OO 

WISH TO CHANGE? 

1 

•ntar n»w value (s) { 

- 1.000 0.000 

NEXT eigenvalue: 

PREVIOUS VALUES? 

0 

LAMBDA 2{ 

REAL* O.OOOOOOE+OO IMAG- O.OOOOOOE+OO 

WISH TO CHANGE? 

1 

enter new value(s) { 

- 1.2000 0.0000 

NEXT eigenvalue: 

PREVIOUS VALUES? 

1 

LAMBDA 3: 

REAL= -0 » 300000E+01 IMAG* O.OOOOOOE+OO 


WISH TO CHANGE? 

0 

WISH TO EXIT FROM THIS MODE? 

1 

*************************** EXITING MODE 2 ************************* 

TERMINATE THIS RUN OR SELECT NEXT MODE: 

WISH TO TERMINATE? 

0 

************************************************t********************* 

********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 

ENTER DESIRED MODE OF OPERATION »M0DE=0» 1 »2> , . . 1 8 { 

3 

******************** MODE 3{EIGENVECT0R ASSIGNMENT ******************* 
********** ENTER OR CHANGE EIGENVECTORS: 


PREVIOUS VALUES? 
0 

EIGENVECTOR V i: 


WISH TO CHANGE? 
1 


(REAL) 

O.OOOOOOE+OO 

O.OOOOOOE+OO 

O.OOOOOOE+OO 


(IMAG) 

O.OOOOOOE+OO 

O.OOOOOOE+OO 

O.OOOOOOE+OO 
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ENTER A NEW DESIRED VECTOR J 

3*75 0.00 

3.25 0.00 

7.00 0.00 

DESIRED VECTORS 

0. 375000E+01 0.325000E+01 0.700000E+01 

ACTUAL VECTORT: 

0.375000E+01 0. 325000E+01 0.700000E+01 

ERROR VECTORT: 


0 ♦ 298023E-07 0.298023E-07 

LENGTH OF THE DESIRED VECTOR > 
LENGTH OF THE PROJECTED VECTOR- 
LENGTH OF THE ERROR VECTOR ■ 

IS THE ERROR ACCEPTABLE? 

1 

NEXT eigenvector: 

EIGENVECTOR V 2‘. (REAL) 

0. OOOOOOE+OO 
O.OOOOOOE+OO 
0 • OOOOOOE+OO 


WISH TO CHANGE? 

1 

ENTER A NEW DESIRED VECTOR : 
-.6700 0.000 

.75000 0.000 

0.000 0.00 

DESIRED VECTOR*. 


O.OOOOOOE+OO 
8 .500501 
8.580501 
0.000000 


(IMAG) 

O.OOOOOOE+OO 

O.OOOOOOE+OO 

O.OOOOOOE+OO 


-0.670000E+00 
ACTUAL VECTORT*. 


0.750000E+00 O.OOOOOOE+OO 


-0 , 700303E+00 
ERROR VECTORT: 


0.719697E+00 0.242424E-01 


0.303030E-01 0.303030E-01 

LENGTH OF THE DESIRED VECTOR « 
LENGTH OF THE PROJECTED VECTOR- 
LENGTH OF THE ERROR VECTOR » 
IS THE ERROR ACCEPTABLE? 

1 

NEXT eigenvector: 

EIGENVECTOR V 3: (REAL) 

O.OOOOOOE+OO 
0 . OOOOOOE+OO 
O.OOOOOOE+OO 


WISH TO CHANGE? 

1 

ENTER A NEW DESIRED VECTOR : 
1.000 0.000 
-1.000 0.000 
.1000 0.000 
DESIRED VECTOR: 


-0.242424E-01 

1.005684 

1.004478 

0.049237 


(IMAG) 

O.OOOOOOE+OO 

O.OOOOOOE+OO 

O.OOOOOOE+OO 


0. 100000E+01 -0 . 100000E+01 

ACTUAL VECTORT: 


0. 100000E+00 
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0 , 966667E+00 -0 , 103333E+0 1 

ERROR VEGTORT I 


0.644467E~01 


0.333333E-01 

1.417745 

1.41656? 

0.057735 


0.333333E-01 0.333333E-01 

LENGTH OF THE DESIRED VECTOR - 
LENGTH OF THE PROJECTED VECTOR- 
LENGTH OF THE ERROR VECTOR 
IS THE ERROR ACCEPTABLE? 

1 

..........CONTENTS OF ’CURRNY* DATA FILE INCLUDE? 

MATRIX V I 

12 3 


1 0.375000E+01 

2 0.325000E+01 


-0 . 700303E+00 
0.719697K+00 


0.966667E+00 

■0.103333E+01 


3 0.700000E+01 0.242424E-01 0.666667E-01 

WISH TO DISPLAY THE NORMALIZED EIGENVECTORS? 

1 

NORMALIZED VECTORS ? 

1 2 3 


1 

9 


0.437037E+00 -0.697181E+00 0.682400E+00 
0.378766E+00 0.716489E+00 -0.729462E+00 
0.815803E+00 0.241344K-01 0.470621E-01 


GAIN MATRIX F? 

1 

1 0.132526E+02 

2 -0. 131S93E+02 
MATRIX AHATt 

1 

1 0.112526E+02 


2 3 

0.1 2534 1E+02 -0. 133833E+02 

-0. 124S26E+02 0.122955E+02 

2 3 

0,1 2534 1E+02 -0 . 123833E+02 

0.13295SE+02 


3 0, 100000E+01 0.100000E+01 -0 . 200000E+01 

WISH TO EXIT FROM THIS MODE? 

1 

*************************** EXITING MODE 3 ************************* 

TERMINATE THIS RUN OR SELECT NEXT MODE? 

WISH TO TERMINATE? 

0 

********************************************************************** 
********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 

ENTER DESIRED MODE OF OPERATION. MODE-O. 1 ,2. ... .8? 

A 
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***) t******************* MODE 4 5 TIME SIMULATION *********************** 
****** **** CHOOSE SIMULATION OPTIONS: 

-ENTER: 1 TO SIMULATE CA3, 2 TO SIMULATE CAHAT3,<3 FOR CAT IL3 ) : 

2 

ENTER 0 TO SIMULATE OUTPUTS, 1 TO SIMULATE STATE VARIABLES: 

1 

ENTER SIMULATION TIME, (REAL NUMBER IN SECONDS) J 
5 

ENTER NUMBER OF POINTS TO BE CALCULATED, <200 MAX): 

150 

SPECIFY THE INITIAL CONDITIONS: 

X 1(0): 

1 

x 2 <o): 

0 

x 3(0): 

0 

CHOOSE INPUT OPTIONS: 1 FOR NO INPUT, 2 FOR A STEP INPUT, 

3 FOR A RAMP, AND 4 FOR A TRUNCATED RAMP : 

INPUT OPTION FOR U IT 
1 

INPUT OPTION FOR U 2: 

2 

SPECIFY AMPLITUDE OF THE STEP INPUT U 2T 
1 

ENTER 0 FOR 80 DISPLAY COLUMNS,! FOR 129 COLUMNS: 

0 

ENTER 0 FOR INDIVIDUAL AND 1 FOR MULTIPLE PLOTS: 

0 

DO YOU WISH TO SET THE MIN-MAX RANGES FOR THE AXES? 

0 

POSITION PAPER AT TOP . OF FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE (20 CHARACTERS.) 

1 HERE WE GO 


ORIGINAL PAGE RS 

OF POOR QUALITY 
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> 10E+01 222222222222222222222222222222222222222222222222222*#**#****+ 

* * 

* * 

* * 

* * 

.90E+00 + + 

* * 

* * 

* * 

* * 

18 OE+OO + + 

* * 

* * 

* * 

$ * 

. 70E+00 + + 

* * 

v * * 

* * 

* * 

. AOE+OO + + 

* * 

* ‘ * 

' * * 

* * 

.50E+00 + + 

* * 

* * 

* * 

* * 

,40E+00 + + 

* * 

* * 

* * 

3|c j|e 

»30E+00 + + 

* * 

* * 

* * 

* * 

• 20E+00 + + 

* * 

* * 

* * 

i * 

» lOE+OO + + 

# * 

* * 

# * 

* * 

O.OOE+OO 0.20E+01 0.40E+01 0.60E+01 


. 80E+00 


.70E+00 


.AOE+OO 


*50E+00 


>40E+00 


. 30E+00 


• 20E+00 


lOE+OO 


TIME 

POSITION PAPER AT TOP OF FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE <20 CHARACTERS.) 

1 
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OF POOR QUALITY 


R 

E 

S 

P 

0 

N 

S 

E 


xxxxx 
X \xxx 


X 

X 


XXXX 

xxxxx 


xxxxxxxxxx 


xxxxxxxxxxxxxxxxx 


0 . 48E+01 +*#****»**+#********+*********+*********+*********+*********+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* X 

* X 

* X 

* 

+ X 

* X 

* 

* X 

* 

+ X 
* 

* X 

* 

* 

+ X 
* 

*x 

* 

* 

+ 

*x 

* 

* 

*x 

+ 

* 

* 

X 
* 

+ 

* 

* 

* X 

He 

0 . 80E+00 +#**##****+****#***#+*********+*********+*********+*********+ 

O.OOE+OO 0.20E+01 0.40E+01 0.60E+01 


0.44E+01 


0.40E+01 


0.36E+01 


0.32E+01 


0.28E+01 


0.24E+01 


0.20E+01 


0.16E+01 


0.12E+01 


TIME 

POSITION PAPER AT TOP OF FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE <20 CHARACTERS.) 

1 
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TIME SIMULATION 


0 . 80E+00 


R 

E 

S 

P 

0 

N 

S 

E 


0.40E+00 


O.OOE+OO 


-0.40E+00 


-0.80E+00 


-0.12E+01 


-0.16E+01 


-0.20E+01 


-0.24E+01 


-0.28E+01 


* 

* 

* 

* 

+ 

* 

* 

* 

* 

+-- 

* 

* 

* 

* 

X 

* 

* 

* 

*x 

+ 

* 

* 

*x 

* 

+ 

*x 

* 

* 

* X 

+ 

* 

* X 

* 

* X 

+ 

* 

* 

'* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 


X 

X 


X 

X 


X xxxxxxxxxxxxxxx 

X xxxxxxxxxxxx 

X xxxxxx 

X xxxx 

XX xxxx 

-0.32E+01 +**#*#**XXXXX*******+*********+*********+****#****+*********+ 

O.OOE+OO 0.20E+01 0.40E+01 0.60E+01 


* 

* 

* 

♦ 

+ 

* 

* 

* 

* 

-+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 


TIME 

POSITION PAPER AT TOP OP FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE (20 CHARACTERS.) 

1 
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0 . 40E400 4*******:m**M*****4****:M***4*****t***4*********4*********4 


0.36E400 + 
* 


xxxxx 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


xxxx 

XX 


0.32E400 


0.28E+00 4 
* 


0.24E400 4 
* 


0.20E400 4 

* 


0. 16E+00 4 

‘ * X 


0.12E400 


0.80E-01 


0*40E-01 


0 . 00E400 4*********4********#4*********4#********4*******#*X#********4 

0.Q0E400 0«20E401 (K40E401 0.60E401 


TIME 


WISH TO REPEAT THE PLOTTING? 
0 

WISH TO EXIT FROM THIS MODE? 
0 
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M********************* MODE 4 : TIME SIMULATION ******************** 
********** CHOOSE SIMULATION OPTIONS: 

-ENTER: 1 TO SIMULATE CAT * 2 TO SIMULATE CAHAT3*(3 FOR CATILT > : 

2 

ENTER 0 TO SIMULATE OUTPUTS* 1 TO SIMULATE STATE VARIABLES: 

1 

ENTER SIMULATION TIME* (REAL NUMBER IN SECONDS): 

5 

ENTER NUMBER OF POINTS TO BE CALCULATED * ( 200 MAX): 

150 

SPECIFY THE INITIAL CONDITIONS: 

X 1(0): 

1 

x 2 <o>: 

1 

x 3<o>: 

l 

CHOOSE INPUT OPTIONS: 1 FOR NO INPUT* 2 FOR A STEF' INPUT* 

3 FOR A RAMP* AND 4 FOR A TRUNCATED RAMP: 

INPUT OPTION FOR U It 
1 

INPUT OPTION FOR U 2: 

1 

ENTER 0 FOR 80 DISPLAY COLUMNS* 1 FOR 129 COLUMNS: 

0 

ENTER 0 FOR INDIVIDUAL AND 1 FOR MULTIPLE PLOTS: 

1 

DO YOU WISH TO SET THE MIN-MAX RANGES FOR THE AXES? 

0 

POSITION PAPER AT TOP OF FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE (20 CHARACTERS* ) 

1 


TIME SIMULATION 
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0.30E+01 +***jm***+*********+*********+*«*«*****+*********+*********+ 


R 

E 

S 

P 

0 

N 

S 

E 


0.25E+01 


0.20E+01 


0.15E+01 


0. 10E+01 


0.50E+00 


O.OOE+OO 


-0.50E+00 


-0* 10E+01 


-0.15E+01 


i» 

* 

* 

* 1 
+ 1 
* 

* 1 
* 

*1 

+ 

*1 

* 

*1 

* 

+ 

1 

* 

* 

* 

333 
« 333 
* 

* 


11 
1111 
1 11 
1 


1 

11 

1 


11 

1 


1 

11 

1 


1 

11 

11 

11 


2 

+ 

* 

* 

*2 

* 

+— 

* 

*2 

* 

+2 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 


333 

333 

333 

333 

333 


11 

11 

11 

11 


11 


11 


3333 

333333 


111 


11111 


3333333333M 1 1 1 1 1 1 1 1 1 
— 3333MMMMMMMMMMMM- 

2222222222 

22222 

222 


C 


9 


22 

99 


90 

99 


9 

lit 

99 


990 


* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

$ 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

* 

* 

* 

* 

+ 

* 

* 

* 

* 

+ 

* 

* 

t 

* 

+ 

* 

* 

* 


* * 

-0 . 20E+01 +**;m****+*********+******#**+*:m*****+*********+*********+ 

O.OOE+OO 0.20E+01 0.40E+01 0.60E+01 


TIME 

WISH TO REPEAT THE PLOTTING? 

CSYSTEMD This Job will be killed in 4 minutes it' it remains inactive 

WISH TO EXIT FROM THIS MODE? / 

1 

*************************** EXITING MODE 4 ************************* 
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********************************************************************** 
********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 

ENTER DESIRED MODE OF OPERATION>MODE=0, 1 t2t . . . »8.‘ 

5 

********************** MODE 5 {COMPONENT REDUCTION ******************** 

ENTER THE COORDINATES OF THE COMPONENT TO BE REDUCED 
ROW*-- * COLUMN® — ( BOTH INTEGERS) } 

3 1 

SET DESIRED WEIGHTS* DEFAULT VALUES ARE* 

F1-F2-1 « OOO 
WISH TO CHANGE? 

0 

J1- 0. 4V0000E+02 J2- O.OOOOOOE+OO 

COST- 0.490000E+02 
GRADIENT MATRIX* 

1 2, 3 

1 -0 < 707107E+00 O.OOOOOOE+OO O.OOOOOOE+OO 

2 -0 . 707107E+00 O.OOOOOOE+OO O.OOOOOOE+OO 

GRADIENT SEARCH ROUTINE* SET SEARCH PARAMETERS.* 

Default values are} 

# of stepS»N- 1 step size*d- 0.100000E-01 d*in- 0.100000E-04 

Wish to chansfe? 

0 

Jl= 0.488022E+02 J2- 0.999V99E-04 

NEW COST- 0.488023E+02 

Cost Function- 0.488023E+02 
Wish to continue the search? 

1 

GRADIENT SEARCH ROUTINE* SET SEARCH PARAMETERS: 

Default values are. 

# of steps*N= 1 step siae*d= 0.100000E-01 dmin* 0.100000E-04 

Wish to change? 

1 

Enter new values. 

:L 0.5 .0001 

J1- 0.394227E+02 J2- 0.260100E+00 

NEW COST- 0 . 396828E+02 

Cost Function* 0.396828E+02 
Wish to continue the search? 

1 

GRADIENT SEARCH ROUTINE* SET SEARCH PARAMETERS} 

Default values are! 

# of steps *N= 1 step si 2 e*rf» 0.500000E+00 dmir.* 0.100000E-03 

Wish to chansfe? 

1 

Enter new values} 

1 .3 .0001 


32 


ORIGINAL page is 


Jl- 0.342750E+02 J2> 0.65A100E+00 

NEW COST* 0. 34931 1E+02 

Cost Function* 0.349311E+02 
Wish to continue the search? 

O 

MATRIX V ! 

12 3 


1 0.317724E+01 -0* 700303E+00 0.966647E+00 

2 0.267724E+01 0.719697E+00 -0 . 103333E+01 


3 0* 585449E+01 0.242424E-01 ' 0 , 66666 7E-01 

WISH TO DISPLAY THE NORMALIZED EIGENVECTORS? 

0 

GAIN MATRIX F! 

12 3 

1 0 , 132540E+02 0.125355E+02 -0. 133827E+02 

2 -0. 131608E+02 -0* 124540E+02 0.122949E+02 

-TERMINATE THIS RUN OR SELECT NEXT MODE* 


WISH TO TERMINATE? 

1 

*****)m**;m*«****3m* mode 4$ time simulation **********!m*##******* 

********** CHOOSE SIMULATION OPTIONS ! 

-ENTER: 1 TO SIMULATE CAT* 2 TO SIMULATE CAHAT3»(3 FOR CATIL3 ) * 

2 

ENTER 0 TO SIMULATE OUTPUTS* 1 TO SIMULATE STATE VARIABLES! 

1 

ENTER SIMULATION TIME* (REAL NUMBER IN SECONDS): 

5 

ENTER NUMBER OF FOINTS TO BE CALCULATED* <200 MAX)! 

150 

SPECIFY THE INITIAL CONDITIONS: 

x i<o>: 

i 

x 2<o>: 

i 

x 3<o>: 
i 

CHOOSE INPUT OPTIONS: 1 FOR NO INPUT* 2 FOR A STEP INPUT* 

3 FOR A RAMP* AND 4 FOR A TRUNCATED RAMP! 

INPUT OPTION FOR U i: 

1 

INPUT OPTION FOR U 2: 

1 

ENTER 0 FOR 80 DISPLAY COLUMNS* 1 FOR 129 COLUMNS: 

0 

ENTER 0 FOR INDIVIDUAL AND 1 FOR MULTIPLE PLOTS! 

1 

DO YOU WISH TO SET THE MIN-MAX RANGES FOR THE AXES? 

0 

POSITION PAPER AT TOP OF FORM AND TYPE ANY INTEGER 
YOU MAY ADD A SHORT NOTE <20 CHARACTERS* > 

1 
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TIME SIMULATION 


0 . 30E+01 +*********+*********+*********+*********+*********♦********* 


R 

E 

S 

P 

O 

N 

S 

E 


0.23E+01 


0.20E+01 


0.15E+01 


0. 10E+01 


* 

* 

* 

* 1 
+ 1 
* 

* 1 
* 

*1 

+ 

*1 

* 

*1 

* 

+ 

1 

* 

* 

* 

333 

* 333 

* 


11 

1111 
1 11 
1 


1 

11 

1 


11 

1 


1 

11 

1 


1 

11 

11 

11 


* 

2 

0.50E+00 + 

* 

* 

*2 

* 

O.OOE+OO +— 
* 

♦2 

* 

* 

-0.50E+00 +2 

t 

* : 

* 

$ i 

-0.10E+01 + 

* : 

* 

* 

* 

-0.15E+01 + 

* 

* 

* 

* 


333 

333 

333 

333 

333 


11 

11 

11 

11 


11 


11 


3333 

333333 


111 


11111 


3333333333M1 1111 1111 

3333MMMMMMMMMMMM- 

2222222222 

22222 

222 


955 


22 


22 

22 


22 


2 


2 


222 


+ 

* 

* 

* 

* 


-0.20E+01 +*********+*********+*********+*********+*********+*********+ 

O.OOE+OO 0.20E+01 0.40E+01 0.40E+01 


TIME 

WISH TO REPEAT THE PLOTTING? 

0 \ 0\0 

WISH TO EXIT FROM THIS MODE? 

1 

*************************** EXITING MODE 4 ************************* 
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*****«**:m****************t**********tt****************************** 
********************* SPECTRAL ASSIGNMENT PACKAGE ******************** 

ENTER DESIRED MODE OP 0FERATI0N'M0DE*0tl'2r ♦ ♦ . »OJ 
6 

MATRIX V t 

12 3 


1 

5 * 


0.317724E+01 

0.267724E+01 


3 0.585449E+01 

GAIN MATRIX FJ 
1 

.1 0« 132540E+02 


-0 . 700303G+00 0 . 9&6667E+00 

0. 719A97E+00 -0. 103333E+01 

0.242424E-01 0.664667E-01 

2 3 

0* 125335E+02 ~0. 133827E+02 


2 -0 « 131608E+02 -0 . 124S40E+02 0.122949E+02 

********************** MODE A (GAIN REDUCTION ************************* 


SET ALPHA PARAMETERS 
DEFAULT VALUES ARE t 
GAIN PARAMETERS i 
1 

• 

♦ 

2 

3 

1 0 « 100000E+01 

0 . 100000E+01 

0 . 100000E+01 

2 0. 100000E+01 

0 . 100000E+01 

0* 100000E+01 

WISH to change: 

0 

COST* 0*9913S0E+03 

Gradient matrix: 

1 

2 

3 

1 -0 * 328984E-04 

0 * 123434E+00 

-0.719359E+00 

2 0.390425E-04 

0, 120108E+00 

-0* A72949E+00 


GRADIENT SEARCH ROUTINE* SET SEARCH PARAMETERS * 

Default values are: 

# of. steps *N= 1 step s-izerd* 0.100000E-01 dm in* 0.100000E-\)4 

Wish to change? 

1 

Enter new values: 

3 

.1 ,0601 

NEW COST* 0 . 107344E+03 

NEW COST* 0 • 389868E+02. 

NEW COST* 0.203202E+02 

Cost Function* 0.203202E+02 
Wish to continue the search? 

0 

MATRIX V t 

12 3 

1 0.317723E+01 -0.663273E+0Q 0.750859E+00 

2 0.267726E+01 0.7S5729E+00 -0. 123522E+01 
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3 

WISH 

0 

0.585449E+01 
TO DISPLAY THE 

0.115S71E+00 0.484359E+00 

NORMALIZED EIGENVECTORS? 

GAIN 

MATRIX FI 
1 

2 

3 

1 

0.220673E+01 

0.143515E+01 

-0.2311I9E+01 

2 

-0.212192E+01 

-0.140673E+01 

0.125216E+01 


TERMINATE THIS RUN OR SELECT NEXT MODE I 

WISH TO TERMINATE? 

1 
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Eigenvalue/Eigenvector Assignment Program Listing 


ORIGINAL PAGE B 
nc POOR QUALITY 


00001 

OOC02 

00C03 

00C04 

00005 

00006 

00C07 

00C08 

00009 

00010 
00011 
00012 
00013 
00C14 

00015 

00016 

00017 

00018 

00019 

00020 
00021 
00022 

00023 

00024 

00025 

00026 

00027 

00028 
00029 
00 030 
00C31 

00032 

00033 

00034 

00035 

00036 

00037 

00038 

00039 

00040 

00041 

00042 
OOC43 

00044 

00045 
00C46 
00C47 
00048 


C4****«*« *******+********♦♦♦******♦♦♦*******+**♦** «♦*♦*** 

C ************************ ******** ********* ***** *** * ****** 
C-Function: Mode Selection. 

C-IN5L routines called: UGETIO. 

C-Spectral Assignment routines: MQOEO through MODES. 

C-Logical devices; Input Unit: 5 Output Unit: 5 

C Storage Unit(s): IU-20 

C— Random Access Files: SY5TEM.DAT 

REAL A (10, 10) ,0(10,10) ,C(10,10) ,ZER0 
INTEGER MQ0E,I0GT,NS,NI ,N0 
COMMON/ SYS/A ,B ,C , ZERO, IDGT ,NS , NI ,N0 
CALL UGETIO (3,5,5) 

C ************************************************************ 

IRS-102 

IU-20 

OPEN (FILE- 'SYSTEM.DAT', ACCESS*' RANDOM*, RE CORO SIZE-1RS 
i*UNIT-IU, MODE-* BINARY* ,DE VICE*' DSK', DISPOSE-' SAVE* ) 

100 WRITE (5,101) 

101 FORMAT (1H/,1X,70(1H*),/,1X,21(1H4), 

129H SPECTRAL ASSIGNMENT PACKAGE ,20(1H*)*// 

2, IX,49HENTER DESIRED MODE OF OPERATION, HODE-C ,1, 2 *• • . ,8: 
READ (5,4) MODE 
IF (MODE.LE.O) GO TO 80 
GO TO ( 1 , 2 ,3 ,4 ,5 ,6 , 7, 8 ) *MODE 

1 CALL M0DE1 

GO TO 99 

2 CALL M0DE2 

GO TO 99 

3 CALL M0DE3 

GO TO 99 

4 CALL M0DE4 

GO TO 99 

5 CALL M0DE5 

GO TO 99 

6 CALL M0DE6 

GO TO 99 

7 CALL M0DE7 

GO TO 99 

8 CALL H0DE8 

GO TO 99 

80 CALL MODEO 
99 WRITE (5,102) 

102 FORMAT ( IX, 39HTERMINATE THIS RUN OR SELECT NEXT MODE:,// 
1* IX, 18HWISH TO TERMINATE?) 

READ (5,4) I 

IF (I.LE.O) GO TO 100 

STOP 

ENO 


ORIGINAL PAGE IS 
OF POOR QUALITY. 


00001 

00002 

00003 
00004 
00C05 
00006 
00007 

ooooa 

00009 

00C10 

00011 

00012 

00C13 

00014 

00015 

00016 

00017 

00018 

00019 

00020 
00021 
0002 2 

00023 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 
00C36 
00 037 

0003 8 
CC039 
00040 
00C41 

00042 

00043 

00044 

0004 5 

00046 

00047 
00C48 

00049 

00050 
00C51 
00G52 
00053 
00C54 

00055 

00056 


C *********************** M******'t**#*******ee*****e4**44*444*4* 44*4 

SUBROUTINE M0DE1 
C-Function: System data entry* 

C-I.1SL routines called: USWFM. 

C-Spectral Assignment routines: - 

C5Logical devices; Input Unit: 5 Output Unit: 5 

C Storage Unlt(s): IU«20. 

C-Random Access Files: SYSTEM.DAT . 

REAL A(L0,10),B(10,10) ,CUO,10) .NULLC 51 
COMMON/ SYS/ A, B,C, ZERO, IDGT,NS,NI,NO 
IU»20 

210 WRITE (5,1) 

1 FORMAT ( IX, 26( 1H*) , 19H MODE l:OATA ENTRY ,25 ( IH*) ,// , IX, 101 IH* ) 
i,34HENTER OR CHANGE SYSTEM PARAMETERS:,//) 

WRITE (5,4) 

4 FORMAT ( 1X,16HPREV IOUS VALUES?) 

READ (5,4) 17 

IF (I7.GT.0) GO TO 220 
230 WRITE (5,2) NS,NI ,N0, IDGT,ZERO 

2 FORMAT (5X,3HNS< B ,I2, 10X,3HN I*, 1 2 , 10X , 3HN0*, 1 2 
1,5X»5HIOGT«,I2,5X,5HZERO«,F15.12,//,1X,15HWISH TO CHANGE?) 

READ (5,4) II 
IF (U.LE.O) GO TO 100 
WRITE (5,5) 

5 FORMAT ( 1X»20HENTER NEW VALUE(S) :) 

READ (5,4) NS,NI,NO,IDGT,ZERO 
WRITE (IU'l) NS, NI ,N0, IDGT , ZERO 

C 

100 CALL USWFM (10HMATRIX A : , 10, A, 10, NS *NS ,4 ) 

WRITE (5,3) 

3 FORMAT ( IX, 15HW ISH TO CHANGE?) 

READ (5,4) 12 
IF (I2.LE.0) GO TO 130 
WRITE (5,5 ) 

READ (5,4) ( (A(I»J),J-l,NS),I-i,NS) 

WRITE ( IU'2 ) ( (A(I,J),J-1,NS),I-1,NS) 

C 

130 CALL USWFM ( 10HMATRIX B : ,10,B,10,NS,NI,4) 

WRITE (5,3) 

READ (5,4) 13 

IF ( I3.LE.0) GO TO 160 

WRITE (5,5) 

READ (5,4) ( (B(I,J),J«1,NI),I-1,NS) 

WRITE ( IU ' 3 ) ( (B(I,J),J-l,NI),I-l,NS) 

C 

160 CALL USWFM ( 10HKATRI X C :, 10, C, 10, NO, NS, 4) 

WRITE (5,3) 

READ (5,4) M 
IF (I4.LE.0) GO TO 200 
WRITE (5,51 

READ (5,4) ( (C(I,J),J«1,NS),I-1,N0) 

WRITE ( IU * 4 ) ( (C(I,J),J»1,NS),I-1,N0) 

GO TO 200 

C*4*****THIS BLOCK ACCESSED ONLY BY A GO TO 220 STATEMENT *4* 

220 CONTINUE 
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00057 READ CIU'U NStNI .NO.IDGTt ZERO 

00C56 READ (IU'2) I I A ( I t J) « J- 1,NS » « I-1,NS ) 

00059 READ f IU • 3 » C (B( I , J) , J-l.NII » I-1,NS> 

00060 READ (IU'4I C (C ( I . J ) . J-l »NS ) * I-l»NO > 

00061 GO TO 2 30 

00062 C *****4**********************3i*** I a'*+ 

00063 200 WRITE (5,6) 

00064 6 FORMAT I1X.29HWISH TO EXIT FROM THIS MODE? » 

00065 READ (5**1 16 

00066 IF (I6.LE.0) GO TO 210 

00067 WRITE <5t7) 

00068 7 FORMAT I lX,27UH*t t I8H EXITING MODE 1 ,25<1H*)> 

00069 RETURN 

00070 END 





00001 

00002 

00C03 

00004 

00005 

00006 

00007 

00008 

00009 

00010 
00011 
00C12 

00013 

00014 

00015 
00C16 

00017 

00018 

00019 

00020 
00021 
00022 
00C2 3 

00024 

00025 

00026 
00027 
0002 8 

00029 

00030 

00031 

00032 

00033 

00034 
00G35 
00036 
00C37 

00038 

00039 

00040 

00041 

00042 
00C43 

00044 

00045 

00046 

00047 

00048 

00049 

00050 

00051 

00052 

00053 

00054 

00055 

00056 
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C******* ******************************************************* 
C ************* ******* ********** ******* ****** ******* ************ 


SUBROUTINE M0DE2 

C-Function: Eigenvalue Assignment* 

C-IMSL routines called: (USWFM). 

C-Spectral Assignment routines: NSA, TRANS • 

C-Logical devices? Input Unit: 5 Output Unit: 5 

C Storage Unltls): IU-20, I U-20+I for I«l*NS. 

C-Random Access Files: SYSTEM. DAT, F0Rxx.DAT where xx-IU-20*I for I-l,NS. 

REAL LRE(10),LIM( 1C) ,S( 10, 30), SCOP Y( 10,30 ),SP( 10,10 ),SPP( 10,20) 
REAL X(30,20),ML(1C,10),NL(10,10) 

REAL NLC(10»20)»PLC( 10 »20)»MLC (10,20) 

REAL ALPHA (20, 20) , BETA ( 20 , 20 ) , KA ( 20 , 10 > ,KB C 20, 10 ) , G AHA C 20 ♦ 20 ) 
REAL ACOPY(20,20),AP(20,20),APP(20,10) 

REAL STAR(20,20),OL(10,20) ,RL( 10,20) 

REAL A(10,10),B(10,10),C(10,10) 

COMMQN/SYS/A,B*C«ZERO, IOGT ,NS,NI,N0 

COMMON/NSPA/ML»NL» NLC* PLC »MLC » STAR,QL » RL/E IG/LRE,L I M 

C****************** READ SYSTEM OATA ************************** 


NS, NI, AO, IOGT, ZERO 
( (A( I,J),J-l,NS),I-l,NS> 
( (B( I, J),J-1,NI),I-1,NS) 


1 ) , 30H MOOE 2 :E I GENVALUE ASSIGNMENT ,20(1H*),// 
1,1X,10( 1H*J ,29H ENTER OR CHANGE EIGENVALUES:,//) 

C WRITE (5,33) ZERO, IOGT !♦* 

C 33 FORMAT (lX,5HZER0-,F15.i2,lX,5HIDGT-,I2) !*♦ 

999 CONTINUE 
IU-I+20 
I RS-202 


IRS-102 

IU-20 


REAO 

(IU'l) 

REAO 

( IU'2) 

REAO 

( IU ' 3 ) 

C 


910 1-1 


WRITE 

(5,1) 

l FORMAT 

( 1X«20( 


OPEN (ACCESS- 
1, UNIT-IU, MODE 


1 RANOOM ' , RECORO SIZE-IRS 

BI N AR Y',0E V ICE- *DSK'» DISPOSE- 'SAVE') 


WRITE (5,11) 

11 FORMAT (IX, 16HPREV IOUS VALUES?) 

REAO (5,*) KO 
IF (KO.GT.O) GO TO 12 
GO TO 13 


C 

12 READ (IU'l) LRE ( I ) ,LIM( I ) 

13 WRITE (5,2) I ,LRE ( I ) ,LI M( I ) 

2 FORMAT ( 1X,6HLAMB0A,I2,1H: ,/,lX,5HREAL-,E15.6,2X,6H I MAG- 
1,E15.6,//,1X,15HWISH TO CHANGE?) 

REAO (5,*) K 1 
IF (Kl.LE.O) GO TO 50 
write (5,14) 

14 format (lx,20henter new value(s) :) 

REAO (5,*) LRE (I), II M( I) 

WRITE (IU'l) LRE( I),LIM( I) 

C***********************IS LAMBDA— I REAL OR COMPLEX?************* 
IF (ABS(LIM(D).GT.ABS(ZERO) ) GO TO 100 
C***********************REAL NULL SPACE FORMULATI ON************** 
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00057 

OOC58 

00059 

00060 
00C61 
00062 

00063 

00064 

00065 

00066 
00067 
OOC68 

00069 

00070 

00071 

00072 

00073 

00074 

00075 

00076 

00077 

00078 

00079 

00080 
00081 
00082 
00083 
OOC84 

00085 

00086 

00087 

00088 

00089 

00090 

00091 

00092 

00093 

00094 

00095 

00096 

00097 

00098 

00099 

00100 
00101 
00102 

00103 

00104 

00105 

00106 

00107 

00108 

00109 

00110 
00111 
00112 


JSSSSSS 


C****+* + ****************F0RH S— LAMBDA— I y (NSX ( NS^NI ) ) 

00 10 II-l.NS 
00 10 I J*1«NS 

sin*iJ)— aim, ij» 

IF ( II.EQ. I J) SC II*IJ>»S(II* IJ)'H.RE(I) 

10 CONTINUE 

INS-NS+1 
JNS-NS+NI 

00 20 II-1,NS 
DO 20 IJ«INS*JNS 
IDUM-IJ-NS 

S(II»IJ)-B(II*IDUH) 

20 CONTINUE 

C CALL USWFM CllHMATRIX SLI s til, S, 10, NS. JNS.4 I ! ♦* 

C *************** ♦*+**+***£ ALL HS A******* ********************** 

C WRITE (5«3) ! ♦* 

C 3 FORMAT (IX* ‘NULL SPACE OF S-LAMBOA-I ,X»KL* > •** 

C write (5*33) zerotidgt !** 

CALL NSA(NS*JNS*S* 10* 30*X» 30»20*ZER0* IOGT * SCOPY *SPP *SP ) 
c ****t**************PARTITION X-KL INTO NL ANO ML ♦****♦***♦♦* 
00 30 II-ltNS 
00 30 IJ-lfNI 
NL(II*IJ)-X( II* I J) 

30 CONTINUE 

WRITE CIU'3) (CNLCII.I J > ♦ IJ“1 *NI ) , I I» 1,NS > 

00 40 II-INStJNS 
00 40 IJ«1*NI 
IHL«II-NS 

MLUML»IJ)«X<II*IJI 
40 CONTINUE 

WRITE ( IU'4 ) ((NL(II»IJ).IJ*1*NI)*II»1*NII 
C CALL USWFM (10HMATRIX NL: *10*NL»10*N$*NI,4 ) !*♦ 

C CALL USWFM (10HMATRIX ML : * 10. ML* 10*NI ♦NI ,4 » !** 

IF CI.GE.NS) GO TO 900 
50 l«I*l 

IF (I.GT.NS) GO TO 900 
WRITE (5*15) 

15 FORMAT (, IX * 16HNEXT EIGENVALUE:) 

GO TO 999 
C 
C 

100 CONTINUE 

C**«*******«*********C0MPLEX NULL SPACE FORMULATION *********** 
C********************FORM S-LAMBDA-C* NSXI2NS+NI) ************* 
00 110 II-1*NS 
DO 110 IJ-l.NS 
S(II*IJ>»- AC 1 1 1 1 J ) 

IF (II.EQ.IJ) S(II*IJ)*S(II«IJ) ♦LREC I ) 

110 CONTINUE 

INS-NS+1 
NS2-2*NS 
NI2»2*NI 

00 120 II-l.NS 
00 120 IJ-INS.NS2 
SIII*IJ>«0.0 
I JDUM-IJ-NS 
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00113 

00114 

00115 

00116 

00117 

00118 

00119 

00120 
00121 
00122 

00123 

00124 

00125 

00126 

00127 

00128 

00129 

00130 

00131 

00132 

00133 

00134 

00135 

00136 

00137 

00138 

00139 

00140 

00141 

00142 

00143 

00144 

00145 

00146 

00147 

00148 
00169 

00150 

00151 

00152 

00153 

00154 

00155 

00156 

00157 

00158 

00159 

00160 
00161 
00162 

00163 

00164 

00165 

00166 

00167 

00168 


IF I II.E0.UDUH> Sllltl J)-LIM(I) 

120 CONTINUE 

IINS-NS2U 
ILC-NS2+NI 

00 130 II-ltNS 
00 130 IJ-IINS»ILC 
IJDUH-IJ-NS2 
S(II*IJ)«B(II*IJDUH) 

130 CONTINUE 

C CALL USWFM (UHMATRIX SLC : *11* S .10, NS * ILC * 4 ) ! ♦♦ 

C************************** CALL NSA ************************** 

C WRITE €5*41 !** 

C 4 FORMAT ( IX* ' NULL SPACE OF SLC* X-KLC * > !** 

CALL NSA (NS*ILC*S*10*30*X*30«20*ZERO * I OCT *SCQPY»SPP*SP I 
c ******«*********+* PARTITION X»XLC INTO NLC»PLC*ANQ «LC ****** 
IS-NS+NI 

00 140 II-1*NS 
00 140 IJ-ltlS 
NLC(II«IJ)-X<II*IJ) 

140 CONTINUE 

WRITE C 1 U • 3 1 C (NLClIItl J) * I J«1*IS I . I I»i«NS > 

C 

00 150 I I"INS»NS2 
DO 150 IJ-ltlS 
IIOUN-II-NS 

PLCI 1 1 DUM » I J )»X ( 1 1 *1 J) 

150 CONTINUE 

WRITE € I U • 4 1 ( (PLCCIItl J ) * I J»l * IS ) * 1 1-1 *NS > 

C 

DO 160 II-IINSyILC 
DO L60 IJ-l.IS 
I JDUN-II-NS2 
NLCI I JDUM* I J )*X( 1 1 *1 J ) 

160 CONTINUE 

WRITE ( IU'5) ( (MLC(II*IJ) *IJ»1*IS) *II»1*NI ) 

C 

C CALL USWFM ( 11HMATRIX NLC : *11* NLC* 10 *NS * IS * 4 ) !** 

C CALL USWFM ( 11HMATRIX PLC : * 11 * PLC* 10* NS » I S * 4 ) ! ** 

C CALL USWFM ( 11HMATRI X MLC S *11* MLC * 10 * NI * IS *4 ) ! ** 

IF (NS.EQ.NI) GO TO 215 

C*4*4*4*44**»******* FORM ALPHA*TRANSPOSE ♦**♦♦***♦*♦♦*****♦* 

00 170 II-1,NS2 
DO 170 IJ-1'IS 
ALPHA (II*IJ) a X(II*IJ) 

IF (II.GT.NS) ALPHA! lit I J)— X( II, IJ) 

170 CONTINUE 

C CALL USWFM C 14HMATRIX ALPHAT: »14»ALPHA*20»NS2»IS*4) !** 

CALL TRANS (ALPHA » NS2* l S ) 

C CALL USWFM I 20HTRANSP0SE OF ALPHAT: » 20 * ALPHA * 20 * I S * NS2 ♦ 4) !* 

C******************** CALL NSA ******************************* 

C WRITE (5*5) ! ** 

C 5 FORMAT (1X**NULL SPACE OF ALPHA* KA •) !** 

CALL NSA ( IS *NS2* ALPHA *20* 20»KA*20» 10*ZER0 » IDGT »ACOPY* APP* AP I 
NMI-NS-NI 

C CALL USWFM (10HMATRIX KA : * 10*K A«20*NS2 *NMI *4 ) !** 

C****«**«********FORM BETA* TRANSPOSE ********************** 
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00169 

00170 

00171 

00172 

00173 

00174 

00175 

00176 

00177 

00178 

00179 

00180 
00181 
00182 

00183 

00184 

00185 

00186 

00187 

00188 

00189 

00190 

00 191 

00192 

00193 

00194 

00195 

00196 

00197 

00198 

00199 

00200 
00201 
00202 

00203 

00204 

00205 

00206 

00207 

00208 

00209 

00210 
00211 
00212 

00213 

00214 

00215 

00216 

00217 

00218 

00219 

00220 
00221 
00222 

00223 

00224 


00 180 II-1'NS 
00 180 IJ*1« IS 
BET A ( 1 1, 1 J )»PLC ( 1 1 *1 J ) 

180 CONTINUE 

C 

00 190 II*INS,NS2 
DO 190 IJ-ltIS 
IDUH-II-NS 

BETA! II* I J)*NLC( IDUM.IJ) 

190 CONTINUE 

C CALL USWFM ( 13HMATRIX BETAT: * 13 ,BETA » 20,NS2 , I S , 4 » ! ** 

CALL TRANS ( BETA ,NS2, I S ) 

C CALL USWFM ( 19HTRANSP0SE OF BETAT: , 19, BETA ,20, I S ,NS2 ,4 » ! *♦ 

C****************** CALL NSA ***** 4 * 4 ***** 4 *** 4 ******* 4 ****** 

C WRITE (5,6) ! ** 

C 6 FORMAT < IX, ’NULL SPACE OF BETA, KB • » !** 

CALL NSA ( IS, NS2, BET A, 20, 20, KB, 20, 10, ZERO, I OCT , ACOPY,AP P, AP I 
C CALL USWFM (10HMATRIX KB : , 10,KB,20,N$2«NMI ,4 ) !** 

C *************** ********* FORM GAMA, TRANSPOSE ***♦♦•♦***♦*♦**** 

00 200 II-1,NS2 
00 200 I J*l» NNI 
GAMA(II»IJ )»KA ( I I , I J) 

200 CONTINUE 

C 

NMI2-2*NMI 
NHU-NMI + 1 
00 210 II-1,NS2 
00 210 I J“NMI1»NHI2 
NMIOUM-IJ-NMI 
GAMAC II,I J)-KB<II,NHIDUM> 

210 CONTINUE 

C 

C CALL USWFM ( 13HMATRIX G AM AT: ,13 ,GAMA ,20, NS 2 ,NMI 2,4 1 !** 

CALL TRANS < G AHA, NS2 ,NM 1 2 ) 

C CALL USWFM ( 19HTRANSP0SE OF GAMAT: , 19, GAMA ,20, NMI 2 , NS2 , 4) J ♦ 

C********************** CALL NSA ***************** 4 ************* 

C WRITE (5,7) 

C 7 FORMAT (IX, 'NULL SPACE OF GAMA, STAR •» !*** 

CALL NSA ( NM 12, NS2, GAM A, 20, 20, STAR, 20, 20, ZERO, IDGT, ACOP Y» APP , AP ) 
GO TO 216 

215 00 216 1 1*1, NS2 
00 216 IJ»1,NI2 
STAR(II,IJ)«FL0AT(0> 

IF (II.EQ.IJ) STARCII, I Ji»FLOAT(l) 

216 CONTINUE 

C CALL USWFM ( 12HMATR IX ST A R: , 12 ,STAR,20,NS2 ,NI 2, 4 » !♦* 

C*********************** PARTITION STAR ********************** 

00 ZiQ II-l.NS 
DO 220 IJ-1,NI2 
OL(II,IJ)*STAR(II,IJ) 

220 CONTINUE 

WRITE ( IU *6 i ((QL(II*IJ),I J*l, NI 2 > ,11*1, NS) 

C 

00 230 II*INS,NS2 
DO 230 I J S 1,NI2 
IDUM-II-NS 
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00225 


RL(IDUM*IJ)-STAR(II*IJ) 


00226 

230 

CONTINUE 


00227 


WRITE ( I U • 7 ) ( (RL( II*IJ) ,IJ-1,NI2) *II-1,NS) 


00228 

C 

CALL USMFH ( 10HMATR IX OL* ,10, QL* 10,NS»NI2, 4 » 

! ** 

00229 

C 

CALL USWFH (10HMATBIX RL* , 10,RL» 10* NS, NI2 , 4 ) 

!*♦ 

00230 

C 



00231 


***+*+*+*« 

00232 


IC-I*1 


00233 


IRS-202 


00234 


IU-IC+20 


00235 


OPEN (ACCESS-'RANDOMSRECORD SIZE-IRS 


00236 


l * UN IT-IU»NOOE-* BINARY* »DEV ICE-* DSK • »DI SP05E- * SAVE * I 

00237 


LRE( ICI-LREI I) 


00238 


LIM(IC) — LIM(I) 


00239 


WRITE (IU*1) LRE ( IC > »LI N( I C I 


00240 


WRITE (5*22) IC,LRE(IC) ,LIM(IC) 


00241 

22 

FORMAT ( 1X»6HLAMB0A. I2»6Ht REAL-»E15«6»2X»6H» 1MAG-«E15*6) 

00242 


IF (IC.6E.NS) GO TO 900 


00243 


I-I+2 


00244 


WRITE (5*15) 


00245 


GO TO 999 


00246 

C 



00247 

900 

WRITE (5*8) 


00248 

8 

FORMAT (1X*29HWISH TO EXIT FROM THIS MODE? ) 


00249 


READ (5**) KK * 


00250 


IF (KK.LE.O) GO TO 910 


00251 


WRITE (5,9) 


00252 

9 

FORMAT (1X,27(1H*),18H EXITING MODE 2 *25I1H«M 

00253 


RETURN 


00254 


END 
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C* * 4 *********** ********************************************* 
c **«***«* **************************************************** 

SUBROUTINE NSA ( MtNtS » i I s, I Js»X, 1 1 x t i jx 'ZERO t IDGT, SCOPYt SPP t SP I 
C-Function: Calculates a basis for the Null Space of a MxN matrix S« 
C-IMSL routines called: UERSETtUERTST tLEQT2F t VSRTUt VSRTRt (USWFM )• 
C-Spactral Assignment routines: - 

C-Logical devices; Input Unit: (5) Output Unit: 15) 

C Storage Unit(s): - 

C-Random Access Files: - 

real s(ils«ijs>*scopy(iis*l Js )* sppi 1 1 s* i JX) »spl 1 1st I Is) 
real x(iix«ijx)«fac* uk 1( 10 )«wk 2(132 )*wk 3(30) 

INTEGER NtNtlMtlNt JN,PVC30)tIPV(30)tKtLt0UH 
INTEGER PVCOPYOO) »RPV(30I 
00 90 I-ltM 
00 90 J-ltN 
SCOPYC I» J)-S( It j) 

90 CONTINUE 

C WRITE (5t2) ZEROtlOGT !♦* 

C 2 FORMAT ( lXt5HZER0- tF15. 12 t lXt 5HIDGT-t 12) !** 

DUM-N-M 

IN-N 

JN-N 

IN-1 

00 20 I-ltN 
PV<II»I 

20 CONTINUE 

IF (ABS(S(IMtIN)).GT.ABS(ZERO)) GO TO 30 
70 IN* IN-1 

GO TO 20 
30 IK-PVCJN) 

PV( JNI*PV(IN) 

IF IIN.EQ.JN) GO TO 50 
PV(!N)-IK 

C* ************ ***EXCHANGE COLUMNS IN AND JN******************* 

DO 40 I-ltN 
IPV( I)-I 
40 CONTINUE 

K-IPV(IN) 

IPV( IN)-IPV(JN) 

IPVC JN)-K 

CALL VSRTU ( S t I IS t M t Nt 0 t IPV,WK 1 ) 

IN* JN 

50 CONTINUE 

IF (IM.EO.M) GO TO 80 
L-IH*1 

C ****************** ******GAUSSI-AN P ROC ESS ****************** ♦* 

00 60 IL-LtN 

IF (ABS(SdLtlN) I.LE.ABS(ZERO) ) GO TO 60 
F AC-S ( ILtlN)ZS(IMtlN) 

DO 60 I-ltN 

SIILtl)-S(ILtl)— FAC*S(IMtI) 

60 CONTINUE 
JN-JN-1 
IM-IM+1 
GO TO 70 
80 CONTINUE 
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C CALL USWFM I 13HS TRIANGULAR* *13*S* IIS«H*N*4) !*« 

C WRITE 15*41 tr* 

C 4 FORMAT ( IX ** PERMUTATION VECTOR *•) }** 

C 00 81 I«l,N !** 

C WRITE 15,4) PVII) !*♦ 

C 81 CONTINUE !** 

C CALL USWFH CiOHMATRIX S **10,SCOPY»IIS*M,N,4l !♦* 

C******«******SHUFFLE SCOPYtUSING PVCOPY********************** 

DO 120 1*1* N 

pvcopYm-pvm 

120 CONTINUE 

CALL VSRTU < SCOPY* II S*M*N.0*PVC0PY*WK1 > 

C ♦♦**4*64**4***44***SC0P Y NOW CONTAINS SOAR******************* 

C CALL USWFM (12HMATRIX SBAR* ♦12»SC0PY*II5*H*N«4) !•* 

C **•**•************♦? ART IT ION SRAR*************************** 

00 100 I*1»M 
00 100 J«1*0UM 
SPPI I »J>-SCOPY( I,J> 

100 CONTINUE 

C CALL USWFM (11HMATRIX SPP * *11* SPP* I IS *M«0UM»4I ! •* 

00 110 I»l*M 
00 110 J»1*M 
JOUH* J+OUH 

SPII,JI-SCOPY(I*JOUM> 

110 CONTINUE 

C CALL USWFM (lOHMATRIX 5P * * 10, SP* I IS »M*H»4 1 !*** 

C ************* *L I NEAR EQUATION S0LUTI0N***4*<M*4****4*******M 
IT-IOGT 

CALL LEQT2F ( SP *DUP*M, I IS * SPP* I T,WK2* IER ) 

CALL UERSET <3*LEV0LD> 

CALL UERTST ( I ER*6HLEQT2F ) 

C WRITE (5*3) IT !♦* 

C 3 FORMAT ( IX *31HIDGT ON RETURN FROM LEQT2F IS -*I3I !** 

C ******************* *****SPP CONTAINS XP********************* 
c *********** SORT PV******* *********************************** 

00 130 I*1»N 
Rpvm-i 
130 CONTINUE 

CALL VSRTR (PV,N*RPV) 

C ************* ****«*****FORM x* *************** *************** 

00 140 I*1«0UM 
00 140 J«1,DUM 
XII , J)«FL0AT(0l 
IF (I.EQ.J) XII* JI*-FLOAT( 11 
140 CONTINUE 

IIDUM-DUM*1 
00 150 I*IIDUM,N 
DO 150 J«l,DUM 
IDUM-I-OUM 
XII* J)*SPP(IDUH* JI 
150 CONTINUE 

C********«************SHIJFFLE ROWS OF X********************** 

C CALL USWFH ( 20HX 3EF0RE SHUFFLING * ,20,X,I IX,N,DUH,4) !*♦ 

CALL VSRTU I X* I [X«N,0UM*1*RPV*WK3) 

C CALL USWFM (20H8ASIS VECTORS ARE S *20.X*I IX*N*0UM,4» !** 

RETURN 


END 
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C tee* ********************* **e********** 0 **********M******** 
C**e****+**«**************v******eeeeeeee*«ee*e*e*e***eeee*e 

SUBROUTINE MODEO 
C-Function: Signature. 

C-IMSL routines called: - 
C-Spectral Assignment routines: - 

C-|.ogical devices; Input Unit: - Output Unit: 5 

C Storage Unit(s): - 

C-Random Access Files: - 
WRITE (5.1) 

1 FORMAT (/.13X.3H***»/»13X» 3H***» 16X» 23HQ I d Dominion University./ 
1.13X.3H***. 10X.36H0epartment of Electrical Engineer ing,/, 13*. 3H*** 
2.21X. 14HMohsen Maref at./ » l3X»3H***»21X.14HSeptember 1982 ) 

WRITE (5.2) 

2 FORMAT (4X»3H*4*.3X.2H**.lX,3H***.3X.3H44*,/.2X,14(lHe).3X,3H**4. 
1/.1X.4I6H*** ).3X.3lHThe Spectral Assignment Package./. IX 

2.4 (6H**4 ).3X.31(1H-) ,/.2X«19(lH*> ./.IX.3I6H **♦) ) 

WRITE (5.3) 

3 FORMAT ( // »6X»52H0ocumentat I on and a user guide for this CAO progr 
lam */*6x*34Hpackage Is avlalable upon request../. 

26X.45HContact Or. R.R. Nielke ft the EE department.) 

RETURN 

ENO 


00001 

00002 

00003 

00004 

00005 
00C06 

00007 

00008 
00009 
OOCIO 
00011 
00012 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 


page Wl 

quality 

C ******************************************* ****** ************** 

c ****** ******* ****** ******************************************** 

SUBROUTINE TRANS <A»IM»IN> 

C-Functlon: Returns the transpose of matrix [A] In A* 

C-IHSL routines called: - 
C-Spectial Assignment routines: - 

C-Loglcal devices; Input Unit: - Output Unit: - 

C Storage Uni t(s): - 

C-Random Access Files: - 

REAL A(20t20>,AT<20»20l 
00 10 I-ltIH 
00 10 J-lfIN 
ATI J»I l-AII, J) 

10 CONTINUE 

00 20 I-lvIN 
00 20 J-ltlM 
A(I ,J)-ATCI«JI 
20 CONTINUE 

RETURN 
END 
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00007 
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00055 
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C***«**+ *************************************************** 
C************ ************************************* ********* 

SUBROUTINE M0DE3 

C-Function: Main routine for Eigenvector Assignment* 

C-IMSL routines called: UERTST,UERSET»USWFV,USWFM*LLSOF,VMULFF. 
C-Spectral Assignment routines: GAIN, IMP, PR0J, NORM. 

C-Loglcal devices; Input Unit: 5 Output Unit: 5 

C Storage Unlttsi: IU-20, IUT-20*NS*l, IU-20* J for J-1,NS. 

C-Random Access Files: SYSTEM. DAT,CURRNT. DAT.F0Rxx.DAT where xx-20*J 
C for J-i,NS. 

C NULL SPACE ARRAYS 

REAL MLIl0,10),NLitl0,10) 

REAL NLC(10»20),PLC(10,20),MLC(10,20) 

REAL STAR(20,20),QLI10,20),RL(10,20) 

C AUX. ARRAYS 

REAL WKAREAI 130), CPI 20, 201 «ATA <20*20 1 ,ATAI (20*20) 

REAL PNLI10,10I,PSTARI 20,201, XXI 10, 101 
REAL LRE( 10) ,LIM( 10) 

C NODE 3 ARRAYS 

REAL VREI10,10),VIM:10,10),VD(20I,VA(20),E(20I,X(20),H(20) 

REAL WJI10) ,W( 10,10 ).V (10,10 ),VINV( 10, 101 ,F I 10,10I,AHATI 10,10) 
INTEGER IP(IO) 

REAL AIIO, 101,8(10,10), C(10, 10) 

CON NON/SYS/A, B,C, ZERO, IDGT ,NS, NI ,N0 
COMMON/AUG/F,AHAT/EIG/LRE,LIM 
CaHMON/ViC/VA,E,X»WJ,W,XX,V,V!NV 
COMMON /NS P A/ NL, NL, NLC, PLC,MLC, STAR, QL,RL 
C****************** READ SYSTEM DATA ****************tis********* 

CALL UERSET (3,LEV0LD) 

IRS-102 

IU-20 

REAO (IU'l) NS«NI,N0« IOGT , ZERO 
READ ( IU ' 2 I ( (A( I , J) ,J-l,NSi,I»l,NS) 

READ (IU*3) ( (B( I, J),J-l,NI),I-l,NS) 

C 

IUT-IU+NS* l 

OPEN IFILE-'CURRNT. DAT', ACCESS-' RANOOM' , RECORD SIZE-IRS 
l,UN IT-IUT , MODE - * BINARY' , DEV ICE- ' DSK' ,01 SPOSE-'SAVE' I 
WRITE (5,1) 

1 FORMAT (1X,20(IH*),31H MODE 3: EIGENVECTOR ASSIGNMENT ,19(1H*) 

1,//,IX,10(IH*) ,30H ENTER OR CHANGE EIGENVECTORS:,//) 

WRITE (5,11) 

11 FORMAT ( IX»16HPREVI0US VALUES?) 

REAO (5,*) KO 

IF (KO.LE.O) GO TO 910 

IFLAG-1 

READ (IUT'l) ((VIII, IJ) ,IJ-1,NS),II-1,NS) 

REAO ( IUT *2 I ((XXIII, IJ), I J-l,NS ) , 1 1- 1,NI I 
910 J-l 

999 CONTINUE 

IU-J*20 
IRS-202 

OPEN ( ACCESS-'RANDCM',RECORO SI ZE-IRS,UNIT- IU 
1, MODE-* BINARY* »OEV ICE-' OSK* ♦ DISPOSE- * SAVE* ) 

IF (IFLAG.NE.l) GO TO 13 

REAO ( IU'2 ) ((VRE(IV,J),VIM(IV,J)),IV»1,NS) 
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OOC57 

00056 

00059 

00060 
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00063 
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13 WRITE (5,14) J 

14 FORMAT ( IX, 13HEIGEN VECTOR V, 1 2, 1H: ,3X,6H( REAL ) • 14X.6HI I MAC) I 
00 10 IV-1,NS 

WRITE (5,15) VRE(IV,J),VIM(IV,J) 

15 FORMAT (15X,E15.6,5X,E15.6) 

10 CONTINUE 

WRITE (5,16) 

16 FORMAT ( 1X,15HWISH TO CHANGE?) 

READ (5,* ) K1 

IF (Kl.LE.O) GO TO 50 
WRITE (5,17) 

17 FORMAT (1X.28HENTER A NEW DESIRED VECTOR :> 

READ (5»*) ( ( VRE ( I V, J ) , V IM ( I V , J ) ) , I V* 1 , NS ) 

WRITE ( I U ' 2 ) ( (VRE( IV, J) ,VIM( IV, J) ) ,IV*1,NS) 

C *♦♦♦**♦***♦*♦♦♦* is V-J REAL OR COMPLEX ? **♦♦***♦♦♦*♦*♦****** 

READ (IU'l) LRE( J) ,LIM( J ) 

IF (ABS(LIM( J)).GT.ABS(ZERO)) GO TO 100 
C****************** real EIGENVECTOR PROJECTION ♦♦*♦♦*+♦******♦* 

READ ( IU ' 3 ) ((NL(II,IJ) , I J«1,NI ) , I I»1,NS ) 

C CALL USWFM (10HMATRIX NLS , 10,NL, 10, NS, NI ,4 ) 

CALL PROJ (NL,NS,NI,10,10, PNL»CP, &TA, ATAI , IDGT ) 

C CALL USWFM (11HMATRIX PNLS ,11, PNL* 10, NS, NS, 4) •** 

c +*+***«+********+*« PROJECT VD ONTO COLUMN SPACE OF N-LAMBDA ** 

25 DO 30 IV— l, NS 

VD( IV)«VRE(IV, J) 

30 CONTINUE 

CALL USWFV( 15H0ESIRED VECTORS ,15, VO, NS, 1,4) 

CALL VMULFF (PNL, VD, NS , NS ,1,10,20, VA, 20, IER ) 

C CALL UERTST ( IER,6HVMULFF ) 

CALL USWFV (15HACTUAL V EC TORTS, 15, VA, NS, 1,4) 

C CALL USWFM (15HVA FROM USWFM s, 15, VA, 20, NS, 1,4) !** 

C****************** PINO THE ERROR VECTOR ****♦♦****♦♦**♦*♦***• 

CALL IMP ( PNL, NS, 10 ) 

C CALL USWFM ( 13HNATRIX I-PNL5 ,13, PNL, 10, NS, NS, 4) !** 

CALL VMULFF ( PNL, VD, NS , NS , l, 10, 20, E ,20, IER ) 

C CALL UERTST ( IER,6HVMULFF ) 

CALL USWFV ( 14HERR0R VECTORTS , 14, E ,NS ,1,4 ) 

CALL NORN (VD«NS,XVO) 

CALL NORM (VA,NS,XVA) 

CALL NORM (E,NS,XE) 

WRITE (5,18) XVD «XVA,XE 

18 FORMAT (1X,31HLENGTH OF THE DESIREO VECTOR -,F15.6,/ 

1, IX, 31HLENGTH OF THE PROJECTED VECTOR-, F15. 6,/ 

2,1X,31HLENGTH OF THE ERROR VECTOR -,F15.6) 

WRITE (5,21) 

21 FORMAT (1X,24HIS THE ERROR ACCEPTABLE?) 

READ (5,*) KK 
IF (KK.GT.O) GO TO 45 
WRITE (5,17) 

READ (5,*) ((VRE(IV,J),VIM(IV,J)),IV-l,NS) 

WRITE (IU'2 ) ( ( VRE ( IV, J ) , VIM( 1 V, J) ) , I V-1*NS ) 

CALL I MP ( PNL , NS, 10 ) 

GO TO 25 

45 DO 46 I V-1,NS 
VCIV, J)-VA(IV) 

46 CONTINUE 


1 


f 
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C**************** SOLVE NL*X-VA FOR X ************************* 


C NOTE* VA IS OESTROYED! 

CALL LLSOF ( NL.10, NS.NI • VA ,-1.0, NI ,X,H, IP, IER) 
CALL UERTST ( IER .6HLLSQF I 

C CALL USWFV (10HVECT0R XT* * 10.X.NI *1 ♦ 4 ) !** 

00 49 IV-l.NI 
XXIIV, JJ-XCIVI 

49 CONTINUE 

IF (J.GE.NS) GO TO 900 

50 J-J*l 

IF (J.GT.NS) GO TO 900 

URITE (5.195 

19 FORMAT ( IX. 17HNEXT EIGENVECTOR*) 

GO TO 999 


100 CONTINUE 

C***************** COMPLEX EIGENVECTOR ASSIGNMENT ************** 
IS-NS+NI 
NI2-2+NI 
NS2-2+NS 
INS-NS+1 

READ (IU*6) <(0L(II,IJ),IJ-1,NI2>,II-1,NS) 

REAO ( IU ' 7 ) ( (RL(II.IJ) »IJ*1»NI2),II*1»NS) 

C CALL USUFM (10HMATRIX QL : , 10.QL, 10, NS.NI2 ♦ 4 ) !♦* 

C CALL USWFM ( 10HMATRIX RL* • 10.RL.10.NS.NI2.4 ) !*♦ 

C *************** FORM STAR AND FIND P-STAR ******************** 
00 105 I 1*1 , NS 
DO 105 IJ-1.NI2 
STAR ( I I » I J)*QL( I I. I J5 
105 CONTINUE 

DO 110 I I*INS«NS2 
DO 110 IJ-1.NI2 
IDUM-II-NS 

STAR (I I, I J)-RL(IOUM.IJ) 

110 CONTINUE 

CALL PROJ (STARyNS2.NI2.20.20.PSTAR.CP.ATA.ATAI.IOGT) 

C CALL USWFM ( 12HMATRIX S TA R * , 12 . STAR . 2 0 ,NS2 .NI 2 . 4 ) • ** 

C CALL USWFM (13HMATRIX PSTAR: . 13.PSTAR.20.NS2.NS2.4 ) !♦* 

C ******* ****** PROJECT VD CNTO THE COLUMN SPACE OF STAR ******** 

114 00 115 IV-l.NS 
VD(IV)*VRE(IV»J) 

115 CONTINUE 

00 120 I V*INS»NS2 
IVOUH-IV-NS 
VD(IV)-VIM< IVDUM.J) 

120 CONTINUE 

CALL USWFV ( 11HC0MPLEX VO *.11. VO. NS 2. 1.4) 

CALL VPULFF (PSTAR, V0.NS2.NS2.1. 20. 20.VA.20. IER) 

C CALL UERTST (IER.6HVMULFF) 

CALL USWFV ( 15HACTUAL VECTORT* . 15, VA.NS2.1 , 4 ) 

C **♦♦♦♦* ********* FIND THE ERROR VECTOR *********************** 


C 

c 


CALL IMP (PSTAR, NS2. 20) 

CALL USWFM ( 15HMATRIX I-PSTAR: , 15.PSTAR.20 ,NS2. NS2 , 41 ! ** 
CALL VHULFF (PSTAR, VD.NS2.NS2, 1,20, 20, E, 20, IER/ 

CALL UERTST (IER .6HVMULFF ) 

CALL USWFV ( 14HERRQR VECTORT: , 14, E ,NS2 , 1,4 ) 
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CALL NORM (VD»NS2»XV0) 

CALL NORM (VA,NS2*XVA) 

CALL NCRM (E,NS2,XE) 

WRITE (5*18) XVO » XVA*XE 
WRITE (5*21) 

READ (5**) KM 
IF (KM.GT.O) GO TO 134 
WRITE (5*17) 

READ (5*4) ((VR6(IV,J),VIM(IV,J)),IV-l,N5) 

WRITE ( IU'2 ) ( ( VRE( IV*J) * V IM( I V* J ) ) *IV-1*NS) 

CALL IMP(PSTAR,NS2»20) 

CO TO 114 
134 IC-J-H 

00 136 IV«l*NS 
VUV, J)-VA(IV) 

IVNS-IV+NS 

V(IV»IC)-VA(IVNS) 

136 CONTINUE 

CALL LLSOF (STAR,20,NS2,NI2.VA,-1.0,NI2,X,HtlP* IERI 
CALL UERTST ( IER *6HLLSQF ) 

C CALL USWFV ( 16HIXX )- j* C XXl-J+l: * 16»X*NI2«1 *4 ) *44 

DO 137 IV-l,NI 
XX(IVyJ)-XdV) 

IVNS-IV+NI 

XX(IV,IC)»X(IVNS) 

137 CONTINUE 

C CALL USWFM ( 13HMATRIX [XX 1 : ,13*XX*10,NI ,NS,4) !*4 

C******************** SET THE CONJUGATE VALUES **************** 

IRS-202 

IU-IC+20 

OPEN (ACCESS-* RANDOM'* RE CORO SIZE-IRS 
1,UNIT-IU*N0DE»' BINARY* »DEV I CE-» OSK* *01 SPOSE-* SAVE*) 

DO 220 I V-l *N S 
VRE(IV,IC)-VRE(IV»J) 

V IM( IV * IC )-— V I M ( IV, J) 

220 CONTINUE 

WRITE (IU'2) ( (VRE( IV,IC)»VIM( I V, I C ) ) , I V-l* NS) 

WRITE (5,14) IC 
DO 230 I V-1*NS 

WRITE (5*15) VRE(IV*IC)*VIM(IV*IC) 

230 CONTINUE 

IF (IC.GE.NS) GO TO 900 

J-J*l 

GO TO 50 

900 CONTINUE 
WRITE (5,901) 

901 F0RMAT(1X,49H— — — — CONTENTS OF "CURRNT" DATA FILE INCLUDE:) 

C CALL USWFM (13HMATRIX [XX 1 : , 13 * XX * 10 *NI ,NS ,4 ) (4* 

CALL USWFM (10HMATRIX V : ,10,V,10,NS,NS*4) *44 

WRITE (5*902) 

902 F0RMAT(1X,44HWISH TO DISPLAY THE NORMALIZED EIGENVECTORS?) 

READ ( 5 , 4 ) KS 

IF (KS.LE.O) GO TO 903 
CALL DSPLAY(NS*ZERO) 

903 CALL GAIN 

CALL USWFM (14HGAIN MATRIX F: ,14,F*10*NI*NS*4) *4* 
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00225 

00226 

00227 

00228 

00229 

00230 

00231 

00232 
0023 3 

00234 

00235 

00236 

00237 

00238 

00239 

00240 


CALL USWFM ( 12HMATRIX AHAT: ,12,AHAT,10,NS,NS,4) ! ** 

WRITE (5*8) 

8 FORMAT ( 1X»29HWISH TO EXIT FROM THIS MODE? ) 

REAO (5,M KT 

IF (KT.GT.O) GO TO 920 

IFLAG-1 

GO TO 910 

920 WRITE (IUT'l) ( ( VII I * I J I , I J-l, NS ) « I I-l *NS ) 

WRITE ( IUT *2 ) ( (XX< II* I J ) , I J-1,NS > , I I-1,NI ) 

WRITE ( IUT' 3 ) ((W(II,IJ)*IJ«1,NS),II-1,NI) 

WRITE ( IUT*4 ) C (F( 11,1 J),I J-1*NS) , II-l.NI » 

WRITE ( IUT *5 J ((AHAT(II,IJ),IJ-1,NS),II*1,NS) 

WRITE (5,9) 

9 FORMAT (IX, 271 IH* ) « 18H EXITING MODE 3 ,25(1H*>) 

RETURN 

ENO 
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C********************************************* 4*44 *+*+*♦**#* 
c ***#***4 ******** ********* *********** ***** *4 *♦ **** *********** 


SUBROUTINE PRO J< A » M»N» I M, I N*P, CP» ATA» ATA I , IDGT ) 

C-Function: Calculates a projection matrix IP] for the allowable 
C- space represented by tAl. 

C-INSL routines called: UERSET » UERTST* LI NV2F » VMULFF»VMULFM» VMULFP * 
C ( USWFM) • 


C-Spectral Assignment routines: - 

C-Logical devices; Input Unit: - Output Unit: (5) 

C Storage Unit(s): — 

C- Random Access Files: - 


C 


10 


C 

C 


C 


C 


C 


REAL. A(IM»IN)»ATAIN*NI»ATAI (N*N) 

REAL P(IM»IM)»CP(N*N)»WKAREA(460) 

CALL UERSET (3,LEV0Ln) 

CALL USWFM(9HHATRIX A: ,9,A, l H,M»N*4 > !** 

00 10 1*1 «N 
00 10 J*lf N 
ATAI ( I »J)*FL0AT(0) 

IF (I.EQ.J) ATAI(I»J)*FL0AT(1) 

CONTINUE 

CALL VMULFM ( A *A *M , N*N* I M . I M * ATA,N * IER ) 

CALL UERTST < IER *6HVMULFM > 

CALL USWFM (UHMATRIX ATA:»11»ATA*N»N*N»4) !♦+ 

CALL LINV2F (ATA«N*N«ATAI* IOGT «WKAREA* IER) 

CALL UERTST I IER , 6HLINV2F ) 

CALL USWFM ( 12HMATRIX ATAI : *12 * AT A I ,N ,N ,N . 4 ) !♦* 

CALL VMULFP ( ATA I * A «N* N , M *N , I M* CP , N » IER ) 

CALL UERTST { IER ,6HVMULFP ) 

CALL USWFM (10HMATRIX CP: tlO*CP,N,N»M»4) ! ** 

CALL VMULFF C A, CP * H,N» M, IM«N* P* IM» IER) 

CALL UERTST ( IER »6HVMULFF ) 

CALL USWFM C10HMATRIX P : .10. P « IM,H»M,4) ! ** 

RETURN 

END 
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00002 

00C03 

00C04 

00005 

00006 
00C07 
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00009 
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00C11 
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£ 444444444644444446 ** 44444444444444444444464444644444444 ** 4*444 

£ 464444 * 444446444 * 44444444 * 444 ** 4444444444644444444444444*44446 

SUBROUTINE NORFI V»N»XNQRNI 
C-Function: Calculates the norm of an N-vector V. 

C-INSL routines called: — 

C-Spectral Assignment routines: - 

C-Logical devices; Input Unit: - Output Unit: - 

C Storage Unit(s): - 

C-Random Access Files: - 
REAL V IN I 
XNORM-FLOATIOJ 
DO 10 I-ltN 
XN0RH«XN0RH4V( 11*62 

10 CONTINUE 

XNORH-SORTIXNORNi 

RETURN 

ENO 
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c************************************************************** 

SUBROUTINE IMP(P,N,IN) 

C-Function: Returns IPl-m-IPl. 

C-IKSL routines called: - 

C-Spectral Assignment routines: - 

C-Logical devices; Input Unit: - Output Unit: 

C Storage Unit(s): - 

C-Random Access Files: - 
REAL PUN, IN) 

00 10 I-1,N 
00 10 J*1,N 
PCI* J>»-P(I,J) 

IF ( I • EO. J ) PC I* Ji-PU, Ji+FLOATIl) 

10 CONTINUE 
return 
end 
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C*************** *********************** ************************ 

C******** ****************************************************** 

SUBROUTINE GAIN 

C-Function: Calculates the Gain matrix, (FI* 

C-IMSL routines called: UERSET»UERTST»LINV2F »LLSOF » VMULFF, ( USWFH*USMFV I • 
C-Spectral Assignment routines: - 

C-Loglcal devices; Input Unit: - Output Unit: (5) 

C Storage Unit(s): IU-20+J for J«1»NS. 

C-Random Access Files: F0Rxx.DAT where xx»2 0+J for J-1,NS« 

C NULL SPACE ARRAYS 

REAL ML(IO.IO) ,NL(10,10) 

REAL NLC(10,20),PLC(10,20)«MLC(10,20) 

REAL STAR (20, 20) ,QL (10,20) ,RL( 10,20) 

C AUX. ARRAYS 

REAL MKAREA(130),H(20) 

C M006 3 ARRAYS 

REAL XX (10,10) ,VA(20),E(20),X(20) ,LRE( 10) ,LIM(10I ,HJ( 10) 

REAL W(10,10) ,V( 10, 10),VINV( 10,10) ,F( 10, 10) ,AHAT( 10,10) 

INTEGER IP(10) 

REAL A(10,10),B(10,10) »C ( 10 , 10 ) 

COMMON/SYS/ A ,8 »C » ZERO » IDGT ,NS » N I »N0 
COMMON/AUG/F,AHAT/EIG/LRE,LIM 
COMMON/VEC/VA,E,X,WJ,W,XX,V,VINV 
COMMON/NSPA/ML,NL,NLC»PLC,MLC,STAR,QL,RL 
CALL UERSET (3.LEV0LD) 

C WRITE (5,1) 

C 1 FORMAT (IX, 'SUBROUTINE GAIN ♦♦♦♦♦♦♦♦+♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦• ) 

IRS-202 

J-l 

10 IU-J+20 

OPEN (ACCESS-'RANOOM', RECORD SIZE»IRS,UNIT«IU 
1,M0DE»' BINARY ',DEV ICE- 'OS K', DISPOSE-' SAVE') 

C++***, ********* is Lambda-J real? ****************************** 

READ (IU'i) LRE( J) ,LIM( J) 

IF (ABS(LIM( J)).GT.ABS(ZERO)) GO TO 30 
c *************** Find rea | wj-j-th column of (Ml **************** 

READ ( IU • 4 ) ((ML(II,IJ),IJ-1,NI),II*1,NI) 

C CALL USWFM (10HMATRIX ML : , 10 ,ML ,10 ,N I ,NI ,4 ) •*+ 

DO 20 IV-l.NI 
X(IV)-XX(IV,J) 

20 CONTINUE 

C********** FORM WJ-INU*X AND PUT MJ IN. J-TH COLUMN OF (Ml 
CALL VMULFF ( ML, X ,NI ,NI , 1,10,2 0,WJ ,10, IER) 

CALL UERTST ( IER , 6HVMULFF ) 

C CALL USWFV (10HVECT0R Wj: ,10,WJ,Nl ,1,4) !*• 

00 25 IV-l.NI 
M ( I V , J l*W J( I V) 

25 CONTINUE 

29 IF (J.GE.NS) GO TO 100 

J-J + l 

GO TO 10 

C**************** Find complex MJ's ***************************** 

30 IS— NS *NI 
NI2-2*NI 
NS2«2*NS 
INS-NS+1 
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READ UU'3) CCNLCCII,IJ),IJ-l,IS),II»l,NS) 

READ C IU • 9 > C(PLC(II,IJ),IJ-l,lS),n-l,NS) 

READ I IU* 5 ) CCMLCC II , I J > , I J-l , I S ) , II»1,NI> 

C CALL USWFH CUHMATRIX NLCs , 11,NLC,10,NS, IS* 9) !♦* 

C CALL USWFM CllHMATRIX PLC : , 11, PLC*10,NS» IS *9) !** 

C CALL USWFM CllHMATRIX MLC: ,11,MLC*10,NI,IS,9) !** 

IC-J-H 

C****** form ALPHAT AND SOLVE t ALPHAT1*X-VA FOR X ♦♦♦**♦******♦ 

DO 135 II-ltNS 
DO 135 IJ-1,IS 
STARCH, IJ)«NLCC II, IJ> 

135 CONTINUE 

DO 190 I I*INS»NS2 
00 190 IJ»1,IS 
IDUM-II-NS 

STARCII,IJ)«- PLCCIDUM,IJ) 

190 CONTINUE 

C CALL USWFM ( 19HMATRIX ALPHAT: • 19,STAR,20,NS2, IS, 9) !** 

DO 90 IV-1,NS 
VACIV)-VCIV,J) 

EIIV)-VA(IV) 

90 CONTINUE 

DO 50 IV*INS»NS2 

IVDUM-IV-NS 

VAC IV 1 » V € IVDUH,1C) 

E ( I V ) *VA C IV) 

50 CONTINUE 

CALL LLSOF C STAR t 20, NS 2 , IS • VA,-1.0, IS « X*H* IP « IER) 

CALL UERTST (IER,6HLLSQF ) 

C CALL USWFV ( 10HVECT0R XT: * 10, X, IS, 1*9) !♦♦ 

C******** FORM HJ-IMLC]*XC AND PUT WJ IN THE J-TH COLUMN OF (W) ♦ 
CALL VMULFF C MLC ,X ,N I , I $ , 1 , 10,20,W J , 10, IER ) 

CALL UERTST ( IER»6HVMULFF) 

C CALL USHFV ( 10HVECT0R WJ: ,10,WJ,NI «1«9I ! ** 

DO 60 IV-1,NI 
WCIV,J)-WJC IV) 

60 CONTINUE 

C 

IF IJ.EQ.IC) GO TO 29 
J-IC 

C********* FORM BETA! AND SOLVE IBETAT J*X-EC»VA) FOR X ♦****♦*♦ 

DO 180 IV-1,IS 
XII V ) «FLOAT ( 0 ) 

180 CONTINUE 

00 185 I 1*1, NS 
00 185 I J-l, IS 
STARCH, I J1«PLC(II,IJ) 

185 CONTINUE 

DO 190 II«INS,NS2 
DO 190 IJ-l,IS 
IDUM-II-NS 

STARCII, IJ)-NLCCIDUM,IJ) 

190 CONTINUE 

C CALL USWFM C13HMATRIX BETAT : , 13, STAR ,20,NS2, IS*9I !** 

DO 70 IV>1,NS2 
VAC I V)-EC IV) 
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00113 

00114 

70 

CONTINUE 
CO TO 50 


00115 

C************** Print CWIt-IWJt then find IFl f and (AHAT! 

*+++*** 

00116 

100 

CONTINUE 


00117 

00 118 

00119 

00120 

C 

CALL USWFN (11HHATRIX I W] : ,11. M«10«N1 .NS. 4 ) 
00 80 II-ltNI 
00 80 IJ-i,NS 
WCIIyUJ — Wf 1 1 « I J I 

! *• 

00121 

80 

CONTINUE 


00122 

C 

CALL USWFN U2HNATRIX -IW 1 : » 12 1 W« 10. NI ,NS ,4 > 

! ** 

00123 

00124 

00125 

C 

CALL USWFN (10HNATRIX V s ♦ 10, V t 10*NS» NS»4 ) 
CALL LINV2F < V ,NS » 10 »V INV » IDGT* WKAREA, IER ) 
CALL UERTST ( IER»6HLINV2F) 

! ** 

00126 

00127 

00128 

C 

CALL USWFN ( 12HNATRIX VINVs,12,VINV,10,NS»NS»4) 
CALL VNULFF ( W,VINV»NI ,NS,NS»10,10,F»10,IER J 
CALL UERTST CIER.6HVNULFF ) 

!*♦ 

00129 

00130 

00131 

C 

CALL USWFN (14HGAIN NATRIX F: tl4.F*10*NI«NS«4) 
CALL VNULFF ( B »F»NS »NI » NS ♦ 10. 10* AHATt 10» IER » 
CALL UERTST ( IER t6HVNULFF ) 

! ♦ * 

00132 

00133 

00134 

00135 

C 

CALL USWFN (4HB*F!»4*AHAT»10»NS*NSt4) 
00 240 II=*1»NS 
00 240 I J*1 »NS 

AHAT ( I I »I J)*AHAT (II»IJ)+A(II«IJ) 


00136 

240 

CONTINUE 


00137 

C 

CALL USWFN ( 12HNATRIX AHAT t » 12 * AHAT »10«NS«NSt4) 

!** 

00138 

c 

WRITE (5*2) 


00139 

00140 

C 2 

FORNAT C1X. ’EXITING SUBROUTINE GAIN 
RETURN 


00141 


END 
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orksnm- 

OF POOR QVJAUTi 

C*************************************************************** 

C ************************* ************************************** 

SUBROUTINE NODES 

C-Funct i on* Facilitates storage and handelllng of CURRENT data* 

C-IMSL routines called: UERSET • 

C-Spectral Assignment routines: -• 

C-Loglcal devices; Input Unit: 5 Output Unit: 5 

C Storage Unlt(s): IU-20, IUT-20+ns*l,IBAK-IUT*I for 1-1,9. 

C- Random Access Files: SYSTEM. DAT, CURRNT.DATyFORxx.DAT where xx-IBAK. 
REAL AUX1 ( 10*10) «AUX2( 10,10) ,AUX3( 10*10) 

REAL XX(10,10),VA(20),E(20),X(20) ,WJ.(10> 

REAL M(I0,10I , VI 10,10) ,VINV(10,10) ,F( 10*101 •AHATIlOtlO) 

REAL A(10,10),B(10,10),C(10,10) 

COMNON/SYS /A,B«C,ZERO, IDGT,N$,NI .NO 
COMMON/ AUG/F , AHAT/AUX/ AUX1* AUX2,AUX3 
COMNON/VEC/VA,E,X,WJ,W,XX,V,VINV 
CALL UERSET ( 3.LEV0LD) 

IU-20 

READ (IU'l) NS ,NI » NO, IOGT, ZERO 
WRITE (5,11) 

11 FORMAT (1X,23( 1H*),22H MODE 0:DATA TRANSFER V 25(1H*),//, 
11X.54HENTER # OF BACKUP FILE YOU WISH TO ADDRESS* I-l 9 :) 

READ (5,*) I 
WRITE (5,12) 

12 FORMAT ( IX , 48H5ET TRANSFER OPTIONS:— 1 FOR ICURRNT1— MBAKUPI1 ,/ 
l,22X,27H— 2 FOR ICURRNTK— IBAKUPIJ,/ 

2,22X,26H— 3 FOR ICURRNTK— MBAKUPI1 ) 

REAO (5,*) IOP 
IUT-20+NS+1 

OPEN ( FILE- 'CURRNT.DAT *, ACCESS-* RANDOM*, RECORD SIZE-102 
1, UNIT- 1 UT, MOOE* ' BI NARY *, DEV I CE-'DSK*, DISPOSE- 'SAVE* ) 

I8AK-IUT+ l 

OPEN ( ACCESS-’RANDOM', RECORD SIZE-102 
1, UNIT-IBAK, MODE-' BINARY* .DEVICE-' OS K* >DI SPOSE-'SAVE* ) 

IF (I0P.E0.2) GO TO 20 

READ ( IUT ' 1 ) ( (V( II, IJ) ,IJ-1,NS) ,11-1, NS) 

READ ( IUT '2 ) ((XX(II,IJ),IJ-1»NS)»II-1,NI) 

READ ( IUT *4 ) ( ( F ( 1 1 , 1 J ) ,IJ— 1,NS) ,11-1, Nl) 

READ ( IUT ' 5 ) ( (AHAT( II, I J) ,IJ-1»NS),II-1»NS) 

C CALL USWFM (10HMATRIX V : ,10, V, 10, NS, NS, 4) **♦ 

C CALL USWFM (10HMATRIX XX : , 10, XX , 10 , NI , NS* 4 ) !** 

C CALL USWFM (14HGAIN MATRIX F : , 14, F , 10, NI »NS ,4 ) ! ** 

C CALL USWFM ( 12HMATRIX A HAT:, 12, AH AT, 10, NS, NS*4) •** 

IF (I0P.EQ.3) GO TO 30 

WRITE (IBAK'l) ( ( V ( I I • I J ) , I J-lyNS) , I I-l, NS ) 

WRITE ( IBAK *2 ) ( (XX ( 1 1 , I J ) , I J- 1, NS) , 1 1 -1,NI ) 

WRITE ( I BAK * 4 ) ( (F ( II, I J) * I J-l,NS) , I I-1,NI) 

WRITE ( I B AK '5 ) ( ( AHAT( 1 1 , 1 J) , I J-1»NS ) ,11-1, NS ) 

GO TO 999 

30 DO 34 1 1 - 1 * NS 

DO 34 IJ-l.NS 
AUX 1(II,IJ)-V(II,IJ) 

AUX2 ( II«IJ)*AHAT(II,IJ) 

34 CONTINUE 

REAO (IBAK'l) ((V( IlylJ), IJ-l.NS), II-l, NS) 

READ ( IBAK • 5 ) ( ( AHAT( 1 1 , I J ) , I J-l.NS ) , I I-l »NS) 

WRITE ( IUT ' 1 ) ( ( V ( II, IJ) ,IJ-1,NS) , I I-l, NS) 

WRITE ( IUT'5 ) <(AHAT(n,IJ),IJ-l,NS),H*l*NS) 
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00059 
00C60 
00061 
00062 
00063 
00066 

00065 

00066 
00C67 
00066 

00069 

00070 

00071 

00072 
00C73 
00076 

00075 

00076 

00077 
00076 
00079 

00060 
00081 
00082 
00083 
00066 

00085 

00086 

00087 

00088 

00089 

00090 

00091 


35 


20 


999 

1 

13 

2 

16 

3 

15 

900 


WRITE (IBAK'l) ( (AUX1(II,IJ)«I<J-1»NS) ,11*1, NS) 
WRITE (I BAK *5 ) I (AUX21 I X * I J)»I J-lfNSI »II-l*NS) 
DO 35 II"l»NI 
00 35 IJxltNS 
AUX2 (lift J )"XX ( 1 1 » I J ) 

AUX3(IItIJ)-F(IItIJ) 

CONTINUE 

READ (IBAK'2) C ( XXIII* I J) 1 1 J«l* NS* * I I-l»Nl 1 
READ ( IBAK *6 ) I (F< II, I J * ,1 J-!*NSI *11-1, NI I 
WRITE (IUT'2 ) ((XX(II,IJ)»IJ-1»NS)»II-1,NI) 
WRITE (IUT'6 I (IFlIItlJI *1 J"1,NS1 * 1 1* 2.* Nil 
WRITE ( IBAK *2) ( ( AUX2I I I* I J) « I J-ltNSI , II-l.NI) 
WRITE ( I B AK ' 6 I C (AUX3( II, I J) *1 J-ltNSI ,11-1, NI I 
GO TO 999 

READ (IBAK'l) ( ( V( II, I J) *1 J-1,NS) , II-1,NS) 

READ (IBAK'2) ( ( XX ( II, i J) * I J-1,NS ) , II-l.NI ) 
READ ( IBAK'6 ) ( (F< II,IJ) ,1 J-1,NS),II-1,NI ) 

READ ( IBAK *5 ) ( ( AHATdl * I J) ,1 J»l t NS ) • II-1,NS> 
WRITE (IUT'l) ((V( II,IJ),IJ-1,NS),II-1,NS> 
WRITE (IUT'2 ) ((XX(II,I J ) , I J-l ,NS > , I 1-1 ,NI ) 
WRITE (IUT'6) ((F(II,IJ),IJ-l,NS),II-l,NIJ 
WRITE ( IUT'5 ) ((AHATdl, IJ) , I J-1,NS ) , I I-l, NS) 
GO TO (1,2,3), IOP 
WRITE (5,13) I 

FORMAT (10X,17HICURRNTJ-->CBAKUP,I1,1H1) 

GO TO 900 
WRITE (5,16) I 

FORMAT (10X,17H!CURRNT1<— IBAKUP, I1,1H)I 
GO TO 900 
WRITE (5,15) I 

FORMAT ( 10X,18H(CURRNT]<—>tBAKUP,Il,lH)) 

RETURN 

END 
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00C01 

C* A************************************************ ************* 

00002 

C***##** ******************************************************** 

00C03 


SUBROUTINE OSPLAYI NS»ZER0 » 

00004 

C-Functlon: Displays normalized Eigenvectos. 

00005 

C-IHSL 

routines called: UShFM. 

00006 

C-Spectral Assignment routines: NORM. 

00007 

C-Loglcal devices! Input Unit: - Output Unit: 5 

0000 9 

C 

Storage Unit(s): IU«20*J for J»i»NS. 

00000 

C-Random Access Files: F0Rxx.DAT where xx*20+J for J*ltNS» 

00010 


REAL MAT<10'10)«LRE(10) ,LI K< 10 > , V A ( 20 ) , E ( 20 ) ,X ( 20 ) , W J< 1 0) 

00011 


PEAL W(10,10)»XX(1C»10J «V(lOflO»*VINV(10tl0t 

00012 


CCMMON/VEC/VA»E» X» U J XX»V»VINV/ElG/LRE»LtH 

00013 


J-l 

00014 

10 

IU«J*20 

00015 


READ UU*1> LREC J) tLIMI J) 

00016 


IF (ABSILIMt JM.GT.ZERO) GO TO 100 

00017 


DO 20 I»l»NS 

oooia 


VA( I )*V( I » J ) 

00019 

20 

CONTINUE 

00020 


CALL NORM! VAtNStXVA) 

00021 


DO 30 I»ltNS 

00022 


MATH , J)-VAU»/XVA 

00023 

30 

CONTINUE 

00024 


GO TO 200 

0002 5 

100 

NS2*2*NS 

OOC26 


JC-J+1 

00027 


00 120 I»ltNS2 

00029 


IF (I.GT.NS) GO TO 110 

00029 


VA( I )*V( I » J ) 

Q0C30 


GO TO 120 

00031 

110 

INS-I-NS 

00032 


VAI I J»V( INS* JC) 

00033 

120 

CONTINUE 

00034 


CALL NORM(VA*NS2*XVA) 

0003 5 


DO 140 I«l*NS2 

00036 


IF (I.GT.NS) GO TO 130 

00037 


MATil »J)*VA(I}/XVA 

00039 


GO TO 140 

00039 

130 

INS-I-NS 

00040 


MAT(INS»JC)*VA(I)/XVA 

00041 

140 

CONTINUE 

00 04 2 


J-J+l 

00043 

200 

IF( J.GE.NS ) GO TO 300 

0004 4 


J-J*l 

00045 


GO TO 10 

00046 

300 

CALL USHFM(20HN0RMALIZE0 VECTORS : ,20»*AT i 10*NS «NS *4 J 

00047 


RETURN 

0004 8 


END 
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00C01 

00002 

00003 

00004 

00005 

00006 

00007 

00008 
00009 
00C10 
00011 
00 C 1 2 

00013 

00014 

00015 

00016 

00017 

00018 
00C19 
00C20 
00021 
00022 

00023 

00024 

00025 
00C26 

00027 

00028 

00029 

00030 
00C31 

00032 

00033 
OOC34 
00C35 
00036 

00037 

00038 

00039 

00040 

00041 

00042 

00043 

00044 

00045 

00046 

00047 

00048 

00049 
00C50 

00051 

00052 
0005.3 

00054 

00055 

00056 


C******* ******** *********************************************** 

C* ************** ******************************** *************** 

SUBROUTINE M00E4 

C-Function: Simulates and plots time responses. 

C-INSL routines called: UERSET»UERTST »UGETI0 , DVERK , VMULFF»USPLO • 
C-Spectral Assignment routines: UEVAL«FCN. 

C-Logical devices; Input Unit: 5 Output Unit: 5 

C Storage Unit(s): IU-20, IUT«20+NS*1. 

C-Random Access Files: SYSTEM. OAT, CURRNT.DAT . 

INTEGER INOPTUO) 

REAL AMP (10) , SLOPE (101 ,U< 10 ), AT IL( 10, 101 , CONST (101 
REAL X(10)»CX(24),W(10*10),Y(10),XPRIME(10) 

C PLOT ARRAYES 

REAL T(201),UHAT(201,10),XMAT(201,lO),VEC(20i),RANGE(4) 

REAL I MAG4( 5151) 

C SYSTEM ARRAYES 

REAL A(lOilO) >8(10*10) »C ( 10* 10) »F I 10, 10 ) * AHAT ( 10* 10 ) 

COnMON/SYS/A*B*C«ZERO* IDGT*NS*NI»NO 

COMMON/AUG/F,AHAT 

COMMON/DIF/ ATIL, CONST 

EXTERNAL FCN 

CALL UERSET ( 3 * LEV OLD ) 

q************** **+* READ SYSTEM DATA ************************** 

IRS-102 

IU-20 

READ < IU'l) NS *N I ,NQ, IDGT * ZERO 
READ (IU'2) ( (A( I, J),J-l,NS),I-l*NS) 

READ (IU'3) ( (B(I,J),J-1,NI),I-1,NS) 

READ ( IU ' 4 ) ( (C(I» J),J-1,NS),I-1.N0I 
IUT«IU*NS*1 

OPEN( FILE-' CURRNT.DAT', ACCESS-* RANDOM*, RECORD SIZE- IRS 
•1, UNIT- I UT, MODE-' BINARY' ,DEVICE- 'DSK' ,OISPOSE«'SAVE' ) 

READ ( IUT * 4 ) (IF(I»J),J-1,NS)»I-1*NI) 

READ ( IUT • 5 ) < (AHAT(I,J) *J— 1*NS) *1-1, NS) 

C 

180 WRITE (5,11) 

11 FORMAT ( 1X,23(1H*) ,24H MODE 4:TIME SIMULATION ,23 (1H* ) ,/ / , IX , 10 ( IH 
1* ) »27H CHOOSE SIMULATION OPTIONS :,/, IX , 1H-,62HENTER: l TO SIMULATE 
2 I AT, 2 TO SIMULATE IAHATI,<3 FOR [ATILI )S ) 

177 CONTINUE 

DO 173 11-1,201 
T(II)-FLOAT(0) 

VEC( 1 1 )-FLOAT ( 0 ) 

178 CONTINUE 

READ (5,*) I SYS 
GO TO (1,2,3), ISYS 

1 DO 10 1-1 ,NS 
DO 10 J-1,NS 
ATIL ( I , J ) -A ( I, J) 

10 CONTINUE 

GO TO 30 

2 DO 20 I-1,NS 
DO 20 J-l , NS 

ATIL ( I, J )-AHAT( I, J) 

20 CONTINUE 

GO TO 30 
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00057 

OOC56 

00059 

00060 
0006 L 
00062 

00063 

00064 

00065 

00066 
00067 
00 06 8 

00069 

00070 

00071 

00072 

00073 

00074 

00075 

00076 

00077 

00078 

00079 

00080 
00081 
00082 

00083 

00084 

00085 

00086 
00087 
0008 8 
00089 


3 WRITE (5,12) 

12 FORMAT (IX,36HENTER SYSTEM MATRIX TO BE SIMULATED: I 

READ (5,4) ( (ATILCI, J)« J*1,NS) ,!«1,NS) 

JO CONTINUE 

WRITE (5,13) 

U FORMAT ( IX, 58HENT6R 0 TO SIMULATE OUTPUTS, 1 TO SIMULATE STATE VARI 
1ABLES: ) 

READ (5,4) IOUT 
WRITE (5,14) 

14 FORMAT ( IX, 47HENTER SIMULATION TIME, (REAL NUMBER IN SECONDS):) 

READ (5,4) DT 
WRITE (5,15) 

15 FORMAT (1X,50HENTER NUMBER OF POINTS TO BE CALCULATED •( 200 MAX):) 

READ (5,4) NP 
WRITE (5,16) 

16 FORMAT (IX, 31HSPECIFY THE INITIAL CONDITIONS:) 

00 40 1*1, NS 
WRITE (5,17) I 

17 FORMAT (1X,1HX,I2,4H(0): ) 

READ (5,4) X(I) 

40 . CONTINUE 

WRITE (5,32) 

32 FORMAT ( 1X,56HCH00SE INPUT OPTIONS:]. FOR NO INPUT, 2 FOR A STEP IN 
1PUT ,/ , IX ,21 ( 1H ) ,40H3 FOR A RAMP , AND 4 FOR A TRUNCATEO RAMPS) 

DO 50 I * 1 , N I 
WRITE (5,18) I 

18 FORMAT ( IX', 18H INPUT OPTION FOR U,I2,1H:) 

READ (5,*) INOPT(I) 

IF ( INOPT(I ) *NE* 2 ) GO TO 51 
WRITE (5,19) I 

19 FORMAT ( IX , 37HSPEC IFY AMPLITUDE OF THE STEP INPUT U,I2,1H5) 

READ (5,4) AMP ( I ) 

GO TO 50 


00C9C 

00091 

00092 
00C93 

00094 

00095 

00096 
00C97 
00090 

00099 

00100 
00101 
00102 

00103 

00104 

00105 

00106 

00107 

00108 
00109 
00 11C* 
00 III 
00112 


51 IF ( INOPT( D.NE.3) GO TO 52 
WRITE (5,21) I 

21 FORMAT ( IX , 33HSPEC IF Y SLOPE OF THE RAMP INPUT U,I2,1H:) 

READ (5,4) SLOPE ( I ) 

GO TO 50 

52 IF ( I NOPT ( I ) «NE» 4 ) GO TO 50 
WRITE (5,22) I 

22 FORMAT ( IX , 33HSPEC I F Y AMPLITUDE AND SLOPE FOR U,I2,1H:) 

REA^ (5,4) AMP Cl) , SLOPE ( I ) 

50 CCJNVINUE 

c *************** DIFFERENTIAL EQUATION SOLUTION ♦*♦♦♦♦♦♦♦*♦♦♦** 
I NO* 1 

T0L-ZER04100. 000000 

TINT-DT/NP 

NP1*NP +1 

DO 100 K* 1 1 NP1 

KMl-K-l 

TEND* FLOAT (KM1)*TINT 

CALL UEVAL ( INDPT, AMP, SLOPE, U, NI , TEND ) 

CALL VMULFF ( 3 ,U ,N S , NI , 1,10, 10 , CONST, 10, IER 1 
C CALL UERTST ( IER , 6HVMULFF ) !** 

CALL OVER* (NS ,FCN ,T ,X ,TEND,TOL,IND,CX, 10, U, IER ) 

IF ( I ND«L T«Q»OR« IER«GT« 0 ) GO TO 190 
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00113 

53 

T(K)»TEN0 

00114 


DO 60 J-t,NI 

00115 


UMAT(K, J)*-U< J) 

00116 

60 

CONTINUE 

00117 


IF ( IOUT.EQ.O) GO TO 80 

00118 


DO 70 J«1,NS 

00119 


XMAT(K, J)»X( J) 

00120 

70 

CONTINUE 

00121 


N-NS 

00122 


GO TO 100 

00123 

80 

CALL VMULFF I C ,X .NO ,NS , 1 , 10» 10, Y , 10* IER 1 

00124 

C 

CALL UERTST { IER,6HVMULFF) I** 

00125 


DO 90 J*1 « NO 

00126 


XMAT(K,J)-Y( J) 

00127 

90 

CONTINUE 

00128 


N-NO 

00129 

100 

CONTINUE . 

00130 

C******** *********** PLOT ******** ********** ******* ************ 

00131 


WRITE (5,23) 

00132 

23 

FORMAT (1X,49HENTER 0 FOR 80 DISPLAY COLUMNS, 1 FOR 129 COLUMNS:) 

00133 


REAO (5,*) I OPT 

00134 

115 

WRITE (5,24) 

00135 

24 

FORMAT ( 1X,48HENTER 0 FOR INDIVIDUAL AND 1 FOR MULTIPLE PLOTS!) 

00136 


REAO (5,*) I PLOT 

00137 


WRITE (5,25) 

00138 

25 

FORMAT ( IX , 5 1HD0 YOU WISH TO SET THE MIN-MAX RANGES FOR THE AXES?) 

00139 


REAO (5,*) IRANGE 

00140 


IF (IRANGE. GT.O) GO TO 120 

00141 


00 110 1*1,4 

00142 


RANGE ( I )*0.0 

00143 

110 

CONTINUE 

00144 


GO TO 124 

00145 

120 

WRITE (5,26) 

00146 

26 

FORMAT ( IX » 41HENTER MIN X,f'AX X,HIN Y, AND MAX Y VALUES:) 

00147 


READ (5,*) (RANGE! I),I*1,4) 

00148 

0************$* plot INPUTS *********************************** 

00149 

124 

DO 125 J-1,NI 

00150 


IF (INOPT(J).NE.l) GO TO 130 

00751 

125 

CONTINUE 

00152 


CO TO 135 

00153 

130 

CONTINUE 

00154 


WRITE (5,33) 

00155 

33 

FORMAT (1X,50HP0SITICN PAPER AT TOP OF FORM ANO TYPE ANY INTEGER,/ 

00156 


i,lX,41HY0U MAY, ADO A SHORT NOTE (20 CHARACTERS.)) 

00157 


READ (5,34) III 

00158 

34 

FORMAT ( 1 1 , 2 OX ) 

00159 


CALL USPLO (T,UMAT,201»NP,NI,1, 13HSYSTEM INPUTS, 13, 4HTIME ,4 

00160 


1, 5H INPUT, 5, RANGE, 1 OH 1234567890, IOPT, IER) 

00161 


CALL UERTST (IER,6HUSPLC ) 

00162 

135 

IF (IPLOT.LE.O) GO TO 140 

00163 

C ******* ******** PLOT STATE VARIABLES OR OUTPUTS ***************** 

00164 


WRITE (5,33) 

00165 


READ (5,34) III 

00166 


CALL USPLO (T,XMAT,201, NP ,N, 1 , 15HT IME SI MULATION, 15 ,4HT IME , 4 

00167 


l,8HRESP0NSE, 8, RANGE, 10H1234567e90, IOPT, IER) 

00168 


CALL UERTST (IER,6HUSPL0 ) 
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00169 CO TO 170 

00170 140 00 160 J-l,N 

00171 00 150 I-l.NP 

00172 VECtll-XMATII, J) ' 

00173 150 CONTINUE 

00174 WRITE (5*33) 

00175 READ (5*34) III 

00176 CALL USPLO ( T» VEC »201*NP * 1, 1, 15HTIME SIMULATIONS. 4HTI ME. 4 

00177 l.SHRESPONSE ,8, RANGE, 1HX, IOPT.IER) 

00178 CALL UERTST I IER.6HUSPL0 ) 

00179 160 CONTINUE 

00180 170 WRITE (5,27) 

00181 27 FORMAT (1X.28HWISH TO REPEAT THE PLOTTINC?) 

00182 READ (5,*) K1 

00183 IF (Kl.GT.O) GO TO 115 

00184 WRITE (5,28) 

00185 28 FORMAT (1X.28HWISH TO EXIT FROM THIS MODE?) 

00186 READ (5,*) K2 

00187 IF (K2.LE.0) GO TO 180 

00108 WRITE (5,29) 

00189 29 FORMAT ( IX , 27 ( IH* ) , 18H EXITING MODE 4 ,25(1H*)) 

00190 GO TO 2 00 

00191 190 WRITE (5,31) INO,IER,K 

00192 31 FORMAT ( IX, 4HINQ-, 12 ,4HIER«* I3.51HCHECK INSTRUCTIONS FOR OIAGNOSTI 

00193 1C MESSAGES ON OVERK,/,1X,28HPROBLEM ON ITERATION NUMBER ,13) 

00194 GO TO 53 

00195 200 RETURN 

00196 END 
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00001 

00002 
00C03 
0000 * 

00005 

00006 

00007 

00008 
00009 
00C10 
00C11 
00012 
00013 
0001 * 

00015 

00016 

00017 

00018 
00019 
00C20 
00C21 
00C22 
00023 
0002 * 


C* ****** ♦♦****♦ * *************** ******************** ************* 
C**«* I************************* ********************************* 

SUBROUTINE UEVAL 1 1 NDFT » AMP , SLOPE »U, N I , TEND ) 

C-Function: Evaluates the input forcing functions* 

C-INSL routines called: - 
C-Spectral Assignment routines: - 

C-Loglcal devices; Input Unit: - Output Unit: - 

C Storage Unites): - 

OKandom Access Files: - 
INTEGER INOPTINI ) 

REAL AMP INI )»S LOPE INI) ,Uf Nil* TENO 
DO 10 1*1, NI 

GO TO (1,2,3,*),INQPTII) 

1 UII )-0. 000000 
GO TO 10 

2 uu>-A*pm 

GO TO 10 

3 U(I)-SLOPE<n*tENO 
GO TO 10 

* IF (TENO*LE*IAMPII) /SLOPE 1 1 ) ) I GO TO 3 
GO TO 2 

10 CONTINUE 

RETURN 
ENO 
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00001 
00002 
0000 3 

00004 

00005 

00006 
00007 

ooooa 

00C09 

00010 

00C11 

00012 

00013 

00014 

00015 

00016 
00017 
00C18 
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c*************** ***************** ***************** ******* ****** 

C* ************************************************* ************ 

SUBROUTINE FCNINS»TfX»XPRIME> 

C-Function: Evaluates x' fuctions for us* by INSL routine DVERK. 

C-INSL routines called: - 
C-Spectral Assignment routines: ~ 

C-Logical devices; Input Unit: - Output Unit: - 

C Storage Uni t ( s I : - 

C-Random Access Files: - 

REAL XINS»,XPRIHFINS»,ATILI10»10J*CONST(10I 
COHNON/O I F/ AT ILtCQNST 
00 10 I*»l ♦ NS 

XPRIHEI I I »AT IL ( Ifll*Xill*ATIL(I»2)*XC2i*ATIL(I*3)*X( 3 )*AT IL I I ♦ 4 I *X 
U4I*ATILU,5)*X{5»*ATILII»6I*X(6»*ATILII.71*XI7)*ATILI1*8 )*X(8)*AT 
2ILCI*9I*X(9)*ATILII»10I*X( 10) ♦CONST! I 1 
10 CONTINUE 
RETURN 
END 
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QUALITY 


00001 

00002 

00C03 

00004 

00C05 

00006 

00007 

ooooa 

00009 

00010 
0G011 
00C12 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 
00021 
00022 

00023 

00024 

00025 

00026 

00027 

00028 
00029 
00G30 

00031 

00032 

00033 
00C34 
00035 
00C36 
00037 
00G38 
00039 
00 040 

00041 

00042 

00043 
00C44 
00C45 

00046 

00047 
00043 

00049 

00050 

00051 

00052 
OOC53 

00054 

00055 

00056 


C ***+*********♦*********** ************************ * ************ 
c ************ ************************************************** 


SUBROUTINE M0DE5 

C-Function: Main routine for Component Modification 
C-INSL routines called: UERSET*USWF.M. 

C-Spectr a I Assignment routines: CGRAO»CCOST*SEARCH»OSPLAY. 

C-Logical devices! Input Unit: 5 Output Unit: 5 

C- Storage Unit(s): IU-20* IU-20* J for J-l»NS*IUT*20*NS*l 

C-Random Access Files: SYSTEM. f)AT*F0Rxx. DAT where xx«20*J *CURRNT.OAT 
REAL AL(10»10> ,G( 10*10) 

REAL XX(10»l0)»VA(2O|,E(20)»X(2O),LRE(10).LIMd0>*WJd0) 

REAL W( 10,10) »V(10,10).*VINV( 10,10) ,F ( 10 , 10 ) , AHAT (10, LO) 

REAL A(10«10)*Bd0*10) idlOilOl 

COMMON/SYS/ A »B*C*ZERO,IDGT,NS.NI»NO 

COMMON/ AUG/F* AHAT/EIG/LRE*LIM/PAR/AL/GR/G 

COMMON/VEC/VA*EfX»WJ«W*XX«V*VINV 

C0MM0N/C0MP/IR0W*ICaL*Fl,F2 

EXTERNAL CCOST,CGRAD 

CALL UERSETI3.LEV0LD) 

IU-20 


READ (IU'1) NS»NI*NO*IDGT,ZERO 

REAO (IU*2) ((A(II,IJ),IJ-1,NS),II-1»NS) 

READ ( IU ' 3 ) ( C B < II, IJ) «I J-l *N I ) * 1 1-1 * NS ) 

DO 10 J»1*NS 

IU-20+J 

'RANDOM'* RECORD SIZE-202 


•* BINARY* yOEVICE" 
LRE(J)«LIM(J) 


•DSK'.DISPOSE-'SAVE') 


'RANDOM' 


OPEN (ACCESS- 
l*UNIT-IU,MOOE 
READ dU'l) 

10 CONTINUE 

IUT-20+NS+1 

OPEN (FILE-'CURRNT. DAT' , ACCESS 
1»UNIT-IUT»M0DE*' BINARY •* DEV ICE-' DSK' .DISPOSE 
REAO (IUT'U ((V(II,IJ),IJ-1»NS)»JI=1*NS) 

C (XX(II.IJ) .1 J-1*NS),II-1,NI ) 

( (F(II,IJ),IJ-l,NS!,II-l*NI) 

( (AHAT(II»IJ) *IJ-1*NS) « I I-l.NS ) 
(10HMATRIX V :»10»V*10*NS*NS»4) 
(10HMATRIX XX:,10,XX»10*NI,NS*4) 
(1AHGAIN MATRIX F : « 14 ,F * 1 0 *NI ,NS .4 1 
( 12HMATRIX AHAT:*12,AHAT*10,NS*NS,4) 
1 1 * NS 
■l, NS 
■V(II,IJI 


REAO 
READ 
READ 
CALL 
CALL 
CALL 
CALL 
DO 20 II 
00 20 IJ 
ALlIIt IJ) 


( IUT *2 ) 
< IUT'4) 
( IUT ' 5 ) 
USWFM 
USWFM 
USWFM 
USWFM 


♦RECORD SIZE-102 
•SAVE' I 


!+* 

!** 

!** 

!** 


20 CONTINUE 

WRITE (5*1) 

1 FORMAT (IX *22 ( 1H* ) »28H MOOE 5*.C0MP0NENT REDUCTION «20(lH*)*//« 
11X .52HENTER THE COORDINATES OF THE COMPONENT TO BE R£OUCEO,/. 

2 IX * 32HR0W- — .COLUMN— (BOTH INTEGERS ) : ) 

REAO (5» + ) 1 RON* ICOL 
WRITE (5*2) 

2 FORMAT (IX » 39HSET OESIRED WEIGHTS.OEFAULT VALUES ARE:*/* 
11X*11HF1-F2-1.000*/»1X,15HWISH TO CHANGE?) 

REAO ( 5 * * ) KK 
F 1-FLOAT ( 1 ) 

• F2-F1 

IF (KK.LE.O) GO TO 30 
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WRITE (5*3 ) 

3 FORMAT ( IX » 17HENTER NEW VALUES* I 

READ (5,*) F1.F2 
30 CALL CCQST(CJ) 

WRITE 15,41 CJ !** 

4 FORMAT (1X,5HC0ST»,E15.6> !♦♦ 

CALL CGRAO 

CALL SEARCH! CJ,CC0ST*CGRAD«5) 

WRITE (IUT’l) <(V(II,IJ),IJ-1,NS),II*1,NS) 

WRITE ( IUT ' 2 ) CIXXCII, IJ),IJ«1, NS», II«1,NI> 

WRITE (IUT'4) ( ( F ( 1 1 , 1 J ) , I J ■ 1 * NS I , 1 1 * 1 , N I ) 

WRITE ( IUT ' 5 ) <(AHAT(II,IJ>,IJ-1,NS),II«1,NS) 

CALL USWFM (10HMATRIX V * • 10, V,10,NS,NS*4I !*♦ 

WRITE (5,902) 

902 FORMAT (1X.44HWISH TO DISPLAY THE NORMALIZED EIGENVECTORS?) 

READ (5,*) KS 
IF (KS.LE.O) GO TO 903 
CALL DSPLAY (NS,ZERO) 

903 CONTINUE 

C CALL USy^M CiOHMATRIX XX: , 10, XX, 10 , NI , NS ,4 ) !*♦ 

CALL USWFM (14HGAIN MATRIX Ft ,14, F, 10, NI, NS, 4) •** 

C CALL USWFM (12HMATRIX AHAT* ,12, AHAT ,10, NS, NS, 4) !♦♦ 

RETURN 
ENO 
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C******* *************************************************** ****** 

c**** *#*******♦****♦*****♦*********+******* ************** ******** 

SUBROUTINE CCOSTICJ) 

C-Functlon: Calculates the COST function for component modification* 
C-IMSL routines called: - 
C-Spectral Assignment routines: - 

C-Loglcal devices; Input Unit: - Output Unit: 5 

C- Storage Unitlsi: - 

C-Random Access files: - 

REAL XXI10,10) ♦VAI20I,EI20>,XI20),LREI10I,LIHI10)*WJI10> 

REAL Ml 10,101 1 V 110. 10 », VI NV 110, 10 1, AL 1 10*101 
REAL AI10, 10) ,B(10,10) ,CI10,10) 

COM '1 ON/SYS/A, 9, C, ZERO, IDCT , NS , NI , NO 

COMMON/ VEC/ VA, E, X,WJ,W, XX, V,VINV 

C0MMON/COMP/ I ROW, I COL, F1,F2/E I C/LRE, LI M/PAR/ AL 

IC0L1-IC0L+1 

CJI-F1*VI I ROW * ICOL ) **2 

IF IABSILIMI ICOL) > .GT.ABS(ZERO) ) C Jl-C J1+F1*V| I ROM* IC0L1I**2 
CJ2»FL0ATI0) 

N*1 

10 N1»N*1 

DO 100 M-1,NS 

IF IN.EO.ICOL.ANO.M.EO.IROW) GO TQ 100 
CJ2-CJ2H IVIM,N)-ALIN,N) )**2)*F2 

IFIABSILIMIN)) .GT.ABSIZERO) ) C J2-CJ2M V|M,N1)-ALIM,N1> ) **2*F2 
100 CONTINUE 

N-N+l 

IF IABSILIMIN) ). GT.ABSIZERO)) N»N*l 

IF IN.LE.NS) GO TO 10 

CJ*CJl*CJ2 

WRITE 15,1) C J1,C J2 

l FORMAT I20X,4H JI*,E15.6,5X,4H J2«,E15.6> 

RETURN 

END 
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C* ***************************** ******** ********* *************** *** 4 
£***« ******************** ****************************************** 

SUBROUTINE CGRAO 

C-Functions Calculates the GRAOIENT for component modification* 

C-IMSL routines called: USWFH 

C-Spectral Assignment routines: PVP.DBNORM. 

C-Logical devices! Input Unit: - Output Unit: 5 

C- Storage Unitlsl: - 

C-8andom Access Files: - 

REAL G(lO*lO)*PJltlO*l0)*PJ2tlO*lO) 

REAL XXI 10*10) ,VA(20)«E(20) ,XI 20 I ,LRE 1 10 1 ,LIM| 10) *W Jl 10 1 
REAL M(10*10»,VI 10*10 »VINV 1 10*10 J»AL 1 10*101 
REAL AI10»10I*8I10»10)*CI10*101 
REAL AUXll 10*10 *AUX2|10, 10) »AUX3( 10*10 
CUMMON/SYS/A,B*C*ZERO, IDGT *NS » NI *N0 

COMMON/ VEC/V A *E«X*kJ*H*XX«V »VI NV/ AUX/AUX1 • AUX2 « AUX3 

C0NM0N/C0MP/IR0W,IC0L*FI,F2/EIG/LRE,LIH/PAR/AL/GR/G/PJ/PJ1»PJ2 

ICOLl-ICOL+l 

J-l 

10 Jl-JM 

00 105 I-l.NI 

KI-I 

KJ-J 

CALL PVP(KItKJ) 

IF IICOL.NE.JI GO TO 14 

PJitI*J)-2*Fl*VIIR0W,IC0Ll*AUXllIR0W,ie0L! 

IF IABSILIMI ICOL I I .LE.ABSIZER01 1 GO TO 15 
C CALL USWFMIBHPV/PXIJ:,8*AUXl,10*NS,NS,41 !** 

C CALL USWFMI10HPV/PXIJM: , 10. AUX2 *10,NS INS, 4 1 !** 

PJU I,J>«PJ1II,J>-»2*F1*¥<IR0H»IC0L1)*AUXII IRNM.ICOLl) 

P Jill ,JI)-2*FIM VI IROW,ICOLl*AUX2t IROW , I COLl )♦¥! I ROW, ICOL II* 
1AUX2IIR0W*ICQL1I ) 

GO TO 15 

14 PJ1II ,JI-FL0ATI0I 

IF I ABSILIMI ICQLI I .GT. ABS I ZERO )> P Jl l I , Jl I -FLOATIO > 

15 PJ2II*J)-FL0AT(0I 

IF I ABSILIMI Jl I.GT.ABSIZEROI I P J2 1 1 , J 1 1 -FLOAT! 0 I 
DO 100 M-1,NS 

IF I J.EO.ICOL.ANO.N.fcO. IR0W1 GO TO 100 
PJ2II, JI-PJ2I I, JIM ALIM* JI-VIM, JH4AUX1IM* Jl 
IF IABSILIMI Jl I .LE.ABSI ZEROI I GO TO LOO 
PJ2II.J1-PJ2I I,JIMALIM,JI)-VIM,J1) >*AUXHN*Jl) 

PJ2I I, J11-PJ2I !, Jl I ♦< ALIM, JI-VIM* Jl I 4AUX2 I M , J I ♦ 

II ALIN,J1>-V(M, Jll 1*AUX2IM, Jll 
100 CONTINUE 

PJ2II*J)«2*F2*PJ2I I,J1 

IF IABSILIMIJII.GT.ABSIZEROI) PJ2I I » Jl 1-2*F2*P J2I I , Jl) 

105 CONTINUE 

IF IABSILIMIJII.GT.ABSIZEROI) J-JM 
J-JM 

IF I J.LE.NSI GO TO 10 
00 110 1 1*1, NI 
DO 110 I J-l, NS 

CIII.IJI -P J 1 1 1 1 * I J)*PJ2II1*IJ) 

110 CONTINUE 

C CALL USWFMIllHfATRIX ( G 1 : * 1 1 ,G , 10.NI , NS*4 ) ! *• 
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CALL 06N0RM I N I , NS I 

CALL USWFMI 16HGRA0 IENT MATRIX: ,16, G, 10, NI , NS, 4) ••* 

RETURN 
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C A****************************************** ***+***++«*«******+*+ 

o*************************************************************** 


SUBROUTINE PVP(KI.kJ) 
C-Funct i on: Returns pIVl/ptX]Ij . 
C-IMSL routines called: (USWFM). 


(51 

CALL statement* 


C-Spectral Assignment routines: - 

C-Loglcal devices; Input Unit: - Output Unit: 

C- Storage Unitlsl: IU*20*KJ »KJ specified by 

C-Random Access Files: FQRxx.DAT where xx*20+KJ. 

REAL AUXK 10*10) .All X2(10*10)*AUX3( 10*10) 

C NULL SPACE ARRAYS 

REAL NL(1O*1O)*NL(1O.IO).ALPHA<2O.2O)»0ETA(2O.2O) 

REAL NLCi 10,20)*PLC(10,20) *MLC< 10.20) 

REAL STAR (20 *20 »QL ( 10* 20 1 ♦ RL ( 10*20 ) 

C *00 E 3 ARRAYS 

REAL XX(10,10)»VA(20),E(20),X(20)*LRE(10).LIM(10) *WJ( 10) 
REAL W(10»10)»V(10,10),VINV(10,10)*F(10.10I.AHAT(10»10> 
REAL A(10*10)*B(10«10) *C(10*10) 

CQMMON/SYS/A,B.C*ZERO* IDGT *NS » NI *N0 

COMMON/VEC/VA,E*X»WJ*W»XX»V,VINV/EIG/LRE*LIM 

COMMON/NSPA/ML*NL»NLC,PLC«MLC*STAR»QL*RL 

COMMON/ AUX/AUX1*AUX2*AUX3 

IU-20+KJ 

IF (ARS(LIM(KJ) )„GT. A8S (ZERO) ) GO T020 
REAO (IU'3) ((NL(II,IJ)»IJ-l,NI).II-i*NS) 

00 10 I-1*NS 
DO 10 J«l,NS 
AUX1( I » J)*FL0A,T(0) 

IF (J.EQ.KJ) AUXK I»J)*NL(I*KI) 

AUX2( I » J)*FL0AT(0) 

10 CONTINUE 

GO TO 30 
20 NI2-NI*2 

REAO ( IU ' 6 ) ( ( QL ( 1 1 * I J ) «IJ*1*NI2)« 11*1* NS) 

REAO ( IU • 7 ) ((RL(IIylJ) *IJ«l*NI2)*II*l*NS) 

C CALL USWFM (10HMATRIX QL : *10,0L »10*NS *NI2 *4 ) !+* 

C CALL USWFM ( 10HMATR IX RL : *10 ,RL * 10 *NS* NI2. 4 ) !** 

K IN*K I+NI 
KJlwKJ+1 


DO 30 1*1 , NS 
DO 30 J*1 *NS 
AUXK I ,J)*FL0AT(0) 

AUX2( I *J)*FLGAT(0) 

IF(J.EC.KJ) AUXK I «J)*QL( 1 *KI ) 

IF(J.EQ.KJl) AUXKI*J)«RL( I*KI) 

I F ( J.EQ.K J) AUX2 ( I « J)*QL ( I *K I N ) 

IF(J.EQ.KJl) AUX2(I»J)*RL(I*KIN) 

30 CONTINUE 

C WRITE (5.1) KI.KJ !** 

C l FORMAT liX» , I***I2»*J»' *12) !** 

C CALL USWFM( BHPV/PX I J : *8 * AUX1* 10.NS *NS *4 ) !** 

C CALL Uy' s JFM(10HPV/PXlJ*i: ,10*AUX2*10.NS.NS*4) !** 

RETURN 
END 
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C ******* ************* ***************************** «***«*******+** 

C* ****** ****************************************** ********* ****** 

SUBROUTINE M0DE6 

C-Funct i on: Main routine for Gain Modification. 

C-IM5L routines called: UERSET.USMFM. 

C-Spectral Assignment routines: GCOST*GGRAD*SEARCH«OSPLAY* 

C-Logical devices! Input Unit: 5 Output Unit: 5 

C- Storage Unit(s): IU»20, IUT»20*NS*1 

C-Random Access Files: SYSTEM. OAT* CURRNT.DAT . 

C GRADIENT APRAYAS 

REAL AL( 10*10) ,G( 10*10) tAUXll 10*10) ,AUX2( 10,10) *AUX3( 10 *10) 
C NULL SPACE ARRAYS 

REAL ML (10* 10 )*NL( 10*10)* ALPHA (20 *20 )* BETA (20 *20) 

REAL NLC(10*20)*PLC(10*20) *MLC (10*20) 

REAL STAR(20*20)*OL(10»20) »RL( 10*20) 

C MODE 3 ARRAYS 

REAL XX ( 10,10)*VA(20)*E(20>* X( 20 » *LRE ( 10 ) ,LI M ( 10 ) »WJ ( 101 
REAL W(10*10)*V(10«1C)«VINV (10*101 *F(10«10)«A HA T( 10* 10) 

REAL A(10*10)*B(10*10)*C(10*10) 

COMMON/ SYS/ A *B*C» ZERO* IDGT*NS * Nl .NO 
COMKON/AUG/F, AHAT/EIG/LRE*LIM/PAR/AL/GR/G 
COMMON/VEC/VA,F,X,KJ,W*XX*V,VINV 
COMMON/NS P A/ML *NL*NLC»PLC*MLC» STAR »QL*RL 
CQMM0N/AUX/AUX1* AUX2.AUX3 
EXTERNAL GCOST *GGRA0 
CALL UERSET(3*LEV0L0) 

IU*20 

READ (IU*1) NS *N I * NO, IDGT * ZERO 

READ < I U * 2 ) ( (A(II,IJ) ,1 J-1,NS) ,II-1»NS) 

READ (IU'3) ((B(Il,IJ),IJ»i,Nl),lI*L,NS) 

IUT«20*NS*1 

OPEN (FILE-'CURRNT. DAT*, ACCESS-'RANOOM* , RECORD SIZE-102 
1. UN IT-IUT.MODE-* BINARY* ♦DEVICE*' OSK' .OISPQSE-'SAVE' ) 

READ ( IUT ' 1 ) ((V(II,IJ),IJ-1*NS),II«1,NS) 

READ ( IUT *2 ) ((XX(II,U),IJ»1,NS),II*1,NII 
READ ( IUT *4 ) ( ( F ( 1 1 * I J > , IJ*1*NS) , 1 1 * 1 »NI ) 

READ ( IUT *5 ) ( (AHAT( 1 1 * I J) ,IJ*1,NS) ,11*1, NS) 

CALL USHFM (10HMATRIX V : , 10, V, 10, NS ,NS,4) !•* 

C CALL USHFM (10HMATRIX XX: ,10, XX, 10, N I ,NS,4 ) ! ** 

CALL USriFM ( 14HGAIN MATRIX F : * 14 ,F « 10 * NI ,NS *4 ) «** 

C CALL USHFM ( 12HMATRIX AHAT: *12 « AHAT , 10 ,NS» NS, 4) !** 

DD 10 II-l.NI 
DO 10 I J* l * NS 
AL( 1 1 * IJ)-FLOAT(l) 

10 CONTINUE 

WRITE (5*1) 

1 FORMAT (1X,22(1H*),23H MOOE 6:GA1N REDUCTION *25(1H*),//, 

11X , 22HSET ALPHA PARAMETERS : */* IX .20H0EF AULT VALUES ARE :) 

CALL USHFM (17HGAIN PARAMETERS : * 17 * AL * 10* N I *NS *4 ) !** 

WRITE (5,2) 

2 FORMAT (1X.15HWISH TO CHANGE:) 

READ (5,*) KK 

IF (KK.LE.O) GO TO 20 
WRITE (5,4) 

4 FORMAT ( IX* 17HENTER NEW VALUES:) 

READ. (5*4) ( (AL( 1 1*1 J) ,IJ*1,NS)*II*1*NI) 


j .. 


I 

I 


77 


sssssw 


00057 

00050 

00C59 

0OC60 

00C61 

00062 

00C63 

00064 

00065 

00066 
00067 
00C6A 
00C69 
00070 
0007 L 

00072 

00073 

00074 

00075 

00076 

00077 


20 CALL GCOSnCJ) 

WRITE 15*3) CJ *** 

3 FORMAT I LXvSHCOST" »E 15 • 6 ) 

CALL GCRAO 

CALL SEARCH(CJ»GCQST»GGRAD,6) 

WRITE IIUT'U <(V< II,IJ) ,1 J-L,NS),II-1,NS) 

WRITE IIUT»2» (<XX<II,IJ),IJ-l,NS>,II»l,NI) 

WRITE < IUT * 4 ) <(F<II,lJ),IJ»i,NS),II-l,NI> 

WRITE ( IUT* 5 J <<AMATUI*IJ)»IJ-1*NS),II-1,NS) 

CALL USWFM (10HMATRIX V : , 10 , V , 10»NS ,NS,4 ) !** 

WRITE <5,902) 

902 FORMAT <1X,44HMIS.H TO DISPLAY THE NORMALIZED EIGENVECTORS?) 

READ (5.*) KS 
IF (KS.LE.O) GO TO 903 
CALL OSPLAY (NS, ZERO) 

903 CONTINUE 

C CALL USWFM CIOHNATRIX XX: ,10, XX, 10, NI ,NS,4 ) ! ** 

CALL USWFM U4HGAIN MATRIX F« ,14,F,10,NI,NS,4) !*• 

C CALL USWFM I 12HMATRIX AHAT: ,12 , AHAT, 10, NS, NS, 4 ) !♦• 

RETURN 
END 
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C*»t* ******************* {,««*«**« *************************** ****** 

£****« ********** ****«***********'*•************* ****************** 

SUBROUTINE SEARCH! CJ*C03T,CRA0*MQOEi 
C-Function: Inter~act I ve Gradient Search Routine. 

C-IMSL routines called* UERSET ,UERTST#UNV2F i , (USMPP)« 

C-Spectrai Assignment routines* GAIN, COST, OES rCN.SENS.GRADvTRAN. 
C-Logrical devices! Input Unit* 5 Output Unit* 5 
C- Storage Un i t (si* - 

C-Random Access Files: - 
C GRADIENT ARRAYAS 

REAL AL( 10,10) ,G<?.0, 10),U(1O*1G| rWKARFA { 130) 

C NULL SPACE ARRAYS 

REAL ML(10,10),NL( 10*10 It ALPHA (20*20), BETA (20* 201 
REAL NLC(10«20)« P LG 1 10 *201* HLC (10*20) 

REAL STAR(2O*2OI*QLilO*20) *RL( 10*20) 

C NODE 3 ARRAYS 

REAL XX <10 *10) ,VA(ZO) *E< 20 ) ,X* 20 ) *LRE (10 ) ,L I M( 10 ) »W J C 10) 

REAL M( 10* 10) «V( 10*10) «VINVU.i!)»lO)«FilOfiO) fAHAT< 10*11)) 

REAL AUO, 101,6(10, 10), C(iOviO) 

COMMON/ SYS /A » 0 ,C * Z ERQ* IDGT »NS*N'l»N0 
COMMON/AUG/F, AHAT/E IG/LRE»LIM/PAR/AL/GR/G/LEG/U 

comhon/vec/va,e,x,i»j,w,xx,v,viny 

COMMON /NS PA/ML »NL»NLC»PLC»MLC,STMK,QL*RL 

CALL UERSET(3,LEV0LDI 

IFL-0 

KN-1 

N-l 

0 - 0.01 

DMIN-ZERO 

10 WRITE (5*1) N.D.DfllN 

1 FORMAT ( IX , 46HGRADI ENT SEARCH R0UTINE»5ET SEARCH PARAMETERS: « // 
l»LX*19HDef aul t values ar e * ,/ ,lx , 13H* of steps*N-*I3«3X,12Hstep siz 
2e*d-»E15.6,3x,5Hdmin-*E15.6»//»lx»l5HWiSh to change7) 

PEAD 15**3 IUP 
IF (IUP.LE.OI GO TC 20 
WRITE (5*2) 

2 FORMAT <lX,l7HEnter new values*) 

READ (5**) N ,0 »0M I K 

20 I N-l 

30 CO 40 1 1-1 « N I 

00 40 IJ-l.NS 

XX ( 1 1 * I J 3 -XX < 1 1 » I J 3— 0*G ( 1 1 * I J ) 

40 CONTINUE 

CALL DESIGN 
CALL GAIN 

IF (MQDE.NE.7) GO TO 49 
IDG- IDGT 

CALL LINV2F ( V»NS * 10*U* IOG, WKAREA* IER ) 

CALL UERTSTI IER.6HLINV2F) 


C CALL USWFM ( 10HMATRIX UT: » 10*U * 10, NS » NS * 4 ) !*♦ 

CALL tran (U,NS«N5 ) 

C CALL USWFM (10HNATRIX U : , 10 ,U * 10*NS , NS * 4 ) !*♦ 

CALL SENS 

49 CALL COST (CJNEH) 

WRITE (5,7) CJNEW !** 

7 FORMAT (IX, ’NEW COST—' * El 5.6 ) !♦* 
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00097 


IF (CJNFW.GE.C J) GO TO 50 

00058 


IF (IN.GE.N) GO TO 100 

OOC59 


C4-CJNEW 

00060 


INMN+1 

00061 


KN-KN+1 

00062 


GO TO 30 

00063 

50 

00 60 ll«l*NI 

00064 


00 60 IJ-1'NS 

00065 


XX(II»m-XX(II *1 J)*D*GUIf I J) 

00066 

60 

CONTINUE 

00067 


IF (KN.EO.l) GO TO 70 

00068 


WRITE (5,3) KN,D 

00069 

3 

FORMAT ( IX, 13, 38H Steps with present gradient and dmin<*«El5.6 

00070 


1, lOHwere taken,/, IX, 23HLAST STEP NOT ACCEPTED!) 

00071 


KN-1 

00072 


CALL GRAD 

00C73 


GO TO 30 

00074 

70 

DH-0/2 

00075 


WRITE (5,8) DH 

00076 

8 

FORMAT (1X,23HLAST STEP NOT ACCEPTED!,/ 

00C77 


1, IX, 21HS TEP SIZE REDUCED T0:,E15.6) 

00078 


IF (OH«LT .OMIN) GO TO 80 

00079 


D-DH 

00C8C 


GO TO 30 

0008 1 

80 

WRITE (5,4) 

00082 

4 

FORMAT ( IX , 36HYou are in d/2 neighborhood of Jain!) 

00083 


IFL-l 

00084 

100 

CALL DESIGN 

00085 


CALL GAIN 

00086 


WRITE (5,5) CJNEW 

00C87 

5 

FORMAT (lX»14HCost Func t I on»,E15.6 ) 

00088 

C 

CALL USWFM (10HMATRIX V : , 10, V , 10, NS , NS, 4 ) !*♦ 

00089 

c 

CALL USWFM (10HMATRIX XX: ,10, XX, 10, NI ,NS,4 ) !** 

00090 

c 

CALL USWFM (14HGAIN MATRIX F* , 14, F, 10, NI ,N5»4) !*♦ 

00091 

c 

CALL USWFM ( 12HNATR IX AHAT : , 12 , AHAT , 10 , NS, NS, 4 ) !*♦ 

00C92 


IF (IFL.E0.1S GO TO 90 

00093 


WRITE (5,6) 

00094 

6 

FORMAT ( IX , 28HW i sh to continue the search?) 

00095 


REAO (5,*) KK 

00096 


IF (KK.LE.O) GO TO 90 

00097 


CJ-CJNEW 

0009 8 


GO TO 10 

00099 

90 

RETUPN 

00100 


ENO 


80 






00001 

00002 

oocoa 

00004 

0000 % 

00006 

00C07 

ooooa 

00009 

00C10 

00011 

00012 

oocia 

00014 

0001 % 

00016 

00017 

00018 

00019 

00020 
00021 
00022 


c **«»*** ************* ******* *************** **************** ***** 

C*4***************************** ************************** ****** . 

SUBROUTINE GCOST(CJ) 

C-Function: Calculates the COST function for Gain Reduction* 
C-IMSL routines called: - 
C-Spectral Assignment routines: - 

C-Logical devices; Input Unit: - Output Unit: 15) 

C- Storage Unit(s): - 

C-Random Access Files: - 

REAL A(lOtlO) * B 1 10*10) *CI 10*10) 

REAL AL(l0,10)«FC10tl0)«AHAT|l0*10) 

CONNON/AUG/F » AHAT/PAR/AL 
CONNON/SYS/ A » BtCtZEROflOGT *NS*NI»N0 
CJ-FLOAT(O) 

DO 10 1*1 »NI 
00 10 J-liNS 

CJ a C J+ALI I «J)*(F(I«J)**2) 

10 CONTINUE 

C WRITE (5« 1 ) C4 !♦* 

C 1 FORMAT C1X»5HC0ST*»E15.6) !•* 

RETURN 
ENO 


ORIGINAL PA®.® 
OF POOR QUALITY 



00001 

00002 

00C03 

00004 

00005 

00006 

00007 

00008 
00009 
00C10 
00011 
00G12 
00013 
00C14 
00015 
00 Cl 6 

00017 

00018 

00019 

00020 
00C21 
00022 
00C23 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 

00036 

00037 

00038 

00039 

00040 
00C41 
00042 
0004 3 

00044 

00045 
.00046 

00047 

00048 

00049 

00050 

00051 

00052 

00053 
00C54 
00C55 
00056 


€*«****# ****** ************ ****************** ****** ********** 
C************* ******* *************************** *** ********* 

SUBROUTINE GGRAD 

C-Function: Calculates the Gradient for Gain Reduction* 

C-IMSL routines called: UERTST »USWFM»LINV2F« 

C-Spectral Assignment routines: DBNORM,PFX* 

C-Logieal devices; Input Unit: - Output Unit: 5 

C- Storage Unit(s): IU-20+J for J*1«NS* 

C-Random Access Files: FQRxx<DAT where xx*20*J • 

C GRADIENT ARRAYAS 

REAL AL 110*101 *G( 10,10) ,AUX1(10,10I *AUX2(10,10) , AUX 3 (10,10) 
C NULL SPACE ARRAYS 

REAL ML ( 10, 10 ) *NL C 10,10) « ALPHA (20*20) .BETA 120*20) 

REAL NLCC 10,20 ),PLC CIO, 201, MLC I 10*20 > 

REAL STAR(20*20)*QL(10,20)*RL( 10*20) 

C AUX. ARRAYS 

REAL MKAREA(130) 

C MODE 3 ARRAYS 

REAL XX (10, 10) *VA(20)*E(20)*X(20) ,LRE ( 10 ) *LI M ( 10) ,WJ(10> 

REAL Ml 10* 10) ,V(10,10) ,VINV(10,10) ,F ( 10, 10) * AHAT ( 10* 10) 

REAL A(IO,10) ,B( 10,10) ,C(10,10) 

CQMMON/SYS / A , B » C » ZERO* IDGT »NS * NI ,N0 
COMMON/AUG/F* AHAT/EIG/LRE.LIM/PAR/AL/GR/G 
CQMMON/VEC/ VA *E * X*WJ*M*XX*V*VINV 
C0MN0N/NSPA/ML*NL* NLC* PLC* MLC* STAR.QL* RL 
COMMON/ AUX/ AUX1,AUX2,AUX3 

C WRITE (5,1) • ** 

C 1 FORMAT ( IX, 'SUBROUTINE GGRAO+++++++++ ♦♦♦♦♦♦♦• ) • *♦ 

CALL LINV2F (V*NS*10*VINV*IDGT* MKAREA* IER) 

CALL UERTST ( IER.6HLINV2F ) 

C CALL USWFM ( 12HMATRIX V INV : *12 * VINV , 10 ,NS * NS , 4 ) •** 

J-l 

10 CONTINUE 

IRS»202 
I U» J ♦ 2 0 

OPEN (AC CESS** RANDOM', RECORD SIZE-IRS.UNIT-IU 
l.MODE-' BINARY' * DEV ICE*'DSK', DISPOSE® 'SAVE' ) 

C*************** j s Lambda-J real? *♦***'%************************ 
READ (IU'l) LRE ( J) *LIM( J ) 

IF (ABS(LIM( J) ) .GT.A8S( ZERO) ) GO TO 30 
C************* Find partials of J wrt elements of [XXI* real case** 
READ IIU'3) l(NL(II,IJ),IJ*l,NI),II*l,NSI 
READ (IU'4) ((MLdl.IJ) , I J* 1 , N I ) , 1 1 »1 , N I ) 

C CALL USWFM ( 10HMATRIX NL : , 10, NL » 10 , NS , NI , 4 ) !** 

C CALL USWFM (lOHHATRIX ML : , 10 ,ML , 10 ,N I , N I , 4 ) !** 

GO TO 15 

C**************** Find complex partials *******♦*♦**♦♦**♦******** 

30 IS-NS+NI 
NI2»2*NI 
NS2«2*NS 
INS-NSd 

REAO (IU'3) ((NLC(II,IJ),IJ»1,IS),II»1,NS) 

READ (IU'4) ((PLC(II«I J)*I J*1,IS), H«1*NS) 

REAO (IU'5) ( (MLC( II, I J),I J-l, IS ) * 1 1*1 *NI ) 

REAO ( IU'6) ((0L(II*IJ),IJ«1,NI2)*II«1,NS) 

REAO <10*71 ((RL( II,IJ) ,IJ«l,NI2),II»l,NS> 
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OOC57 

00056 

00059 

00060 
00061 
00C62 
00063 
00066 

00065 

00066 

00067 

00068 
00C69 
00C70 

00071 

00072 

00073 
00076 

00075 

00076 
00C77 

00078 

00079 

00080 
00081 
00082 
00083 
00086 
00C85 
00086 
00087 
00C8H 
00089 
00C90 

00091 

00092 
00C93 
00096 
00C95 
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c 

c 

c 

c 

c 


15 


c 

C 2 
100 


150 


CALL USWFM (11HMATRIX 
CALL USWFM ( 11HMATRIX 
CALL USWFM ( 11HMATR I X 
CALL USWFM ( 10HMATR IX 
CALL USWFM (10HMATRIX 
00 100 I-1,NI 
G (J , J ) “FLOAT ( 0 ) 

KJ-J 


NLC i *11* NLC»10*NS* IS *6 ) 

PLC*,il,PLC,10,NS,IS,6> 

MLC*,11«MLC,10,NI«IS,6) 

0L:,10,QL,10,NS*NI2,6) 

RL!,10,RL,10,NS,NI2,6) 


f *♦ 
! ♦ * 
! ** 

! ** 
• 


KI-I 

CALL PFX(KI,KJ,IFLAG> 

If ( I FLAG • NE • 0 ) GO TO 150 
00 100 IP-1, NI 
DO 100 1 0-1 , NS 

GU ,J)«G( I,J)+2*AL<IP,IQ)*F(IP,I0)*AUX3<IP,IQ> 

WRITE (5,2) IP,IQ«I,J«G(I,J) ! ** 

FORMAT (2 OX, * PF • ,12,12, ’/X ',12,12,' «• ,E15 j6* *PARTl AL SUMS ' I ! ♦♦ 
CONTINUE 

IF (IFLAG.EQ.l) J-J*l 
IF (J.GE.NS) GO TO 200 
J-J*i 
GO TO 10 


JO-J+i 


00 70 IP-1, NI 
DO 70 IQ-1, NS 

G(I,J)-G( I,J)+2*AL(IP,I0)*F( IP,IQ)*W(IP,IO) 

70 CONTINUE 

G(I, JD)-FLOAT(O) 

DO 75 IP-1, NI 
00 75 IQ-1, NS 

G(I»JD)-G(I,JDI+2*AL(IP,IQ)*F(IP»IQ)*£UX3CIP»I0) 
75 CONTINUE 

GO TO 100 

C************** Print IGJ, then find IGl/SIGSS *♦*♦*♦* 


200 CONTINUE 

C CALL USWFM ( 11HMATRIX I G ] : , 11 , G , 10 , N I ,NS,6 ) !** 

CALL DBNORM ( N I ,NS ) 

CALL USWFM (16HGradient mat r i * : , 16 , G , 10,NI ,NS , 6 ) ! ** 

RETURN 

ENO 
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PAGE S3 
QUALITY 


00001 

00002 

00003 

00004 

00005 

00006 

00007 

00008 

00009 

00010 
00C11 
COOL 2 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 
00021 
00022 

00023 

00024 

00025 

00026 
00027 
0002 8 

00029 

00030 


o +« * *** *** ****** **# **** ******** ♦*♦♦+***********♦♦ ********* +*** « 

c*+***************** *********** ********«*+*******+***♦********«** 

SUBROUTINE INSTEP 

C-Funct I on: Called by PFX calculates I AUX3 I- ( t AUX1 ]-[ AUX2 ] » *1 VI NV 1 
C-IMSL routines called: UERTST, VMULFF « ( USWFM ) . 

C-Spectral Assignment routines: - 

C-Logical devices! Input Unit: - Output Unit: (5) 

C- Storage Unit(s): - 


C-Random Access Files: - 

REAL AUXKlOflCI , AUX2 ( 10 , 10 ) , A UX3 ( 10 > 10) 

REAL XX(10,10),VA(20),E<20),X(20),WJ( 101 

REAL W(10, 10) ,V< 10,10) ,VINV< 10,10) ,F (10,10 ),AHAT<10,10> 

REAL A(10,1G) , B ( 10 , 10 ) »C(10»10) 

COMMON/ VEC/ VA, E,X,WJ,W, XX, V, VI NV/AUG/F.AHAT 
COMMON/ AUX/AUX1, AUX2.AUX3 
C OM MON /SYS/A, B,C, ZERO, I OCT, NS, NI ,N0 
C CALL USWFM ( 7H[ AUX 1 J : ,7 ,AUXl , 10 ,NI , NS , 4 ) '.** 

C CALL USWFM (7H£AUX2]:,7,AIJX2,10,NS,NS,4) ! ** 

CALL VMULFF (F,AUX2»NI»NS,NS,10»10»AUX3,10» IER) 

CALL UERTST( IER , 6H V MULFF ) 

C CALL USWFM ( 7H [ AUX3 1 : . 7 , AUX3, 10, NI , NS , 4 ) ! ** 

00 10 II-l.NI 
00 10 I J=1 » NS 

AUX2(II,IJ)-AUX1(II,IJ)-AUX3(II,IJ) 

10 CONTINUE 

CALL VMULFF( AUX2 , V INV, NI ,NS,NS, 10, 10, AUX3, 10, IER) 

CALL UERTSTi IER.6HVMULFF I 

C CALL USWFM 1 7HI AUX3 1 * ,7,AUX3* 10. NI ,NS ,4 ) !♦* 

RETURN 

ENO 
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oocoi 

00002 

00003 

00004 

00005 
00006 

00007 

00008 
00009 
OOCLO 
00CL1 
00012 

00013 

00014 

00015 

00016 
00017 

oooia 

00019 

00020 
00 021 
00022 
00023 


C************ *** ******** ******* ******************* ************* ** 
C************ ************************************** ************** 

SUBROUTINE OBNORM ( N I »NS ) 

C-Functlon: Returns a normalized NIxNS matrix in Itself* 

C-INSL routines called: - 
C-Spectral Assignment routines: - 

C-Logical devices! Input Unit: - Output Unit: - 

C- Storage Unitlsl: - 

C-Random Access Files: - 

REAL C ( 10 » 10 1 tNORN 
CONNON/GR/G 
N0RH-FL0ATC01 
00 10 1-5, »NI 
DO 10 J«1»NS 
NORH-NORH*G i I » J) **2 
10 CONTINUE 

NORN- SORT! NORM ) 

00 20 I-1«NI 
DQ 20 J-l «NS 
GU t JI-GII.JI/NORN 
20 CONTINUE 

RETURN 
END 


00C01 

00002 

00003 

OOOO^i 

00005 

00006 

00007 

00008 

00009 

00010 
00CL1 
00012 

00013 

00014 
00C15 
00016 

00017 

00018 
00C19 
00020 
00C21 
00022 

00023 

00024 

00025 

00026 
00C27 
00C28 

00029 

00030 

00031 

00032 

00033 

00034 

00035 

00036 

00037 
00C38 
00039 
00C40 

0004 1 

00042 

00043 

00044 

00045 
OOC46 
00047 
00049 

00049 

00050 

00051 

00052 

00053 
0005 4 

00055 

00056 


jsasM 


C* ****** *********************************************************** 
C**** ********************************************* **************** 


SUBROUTINE DESIGN 

C-Function: Given a Designator matrix IX], calculates IV], 
C-IMSL routines called: UERTST »VMULFF» (USWFM) , 


Output Unit: (5) 


C-Spectral Assignment routines: - 
C-Logical devices; Input Unit: - 

C- Storage Unit(s): IU-20+J 

C-Random Access Files: F0Rxx.DAT where xx-20*J for J-l»NS. 

C NULL SPACE ARRAYS 

REAL ML ( 10,10) »NL ( 10,10) 

REAL NLC(10*20),PLC( 10,20) « MLC ( 10*201 
REAL STAR(20,20),QL(10,20) ,RL( 10,20) 

C MODE 3 ARRAYS 

REAL XX (10 ,101 ,VA(20) ,E( 20 ) ,X( 20 ) ,LRE ( 10 ) ,LIMI 10) ,W J C 101 
REAL W( 10,10) ,V( 10,101 ,VINV( 10,10) 

REAL A(10,10),B(10,10) ,C(10,10> 

COMMON /SYS/A ,B,C» ZERO* IDGT, NS »NI, NO 
COMMON/E I G/LRE *L!M 
COMMON/ VEC/VA,E,X,WJ,W, XX, V.VINV 
COMMON/NSPA/ML«NL*NLC*PLC*MLC*STAR*QL* RL 
C WRITE (5*1) !** 

C 1 FORMAT ( IX* ' SUBROUTINE DESIGN ♦♦♦♦♦♦+♦♦♦♦♦♦♦♦♦♦♦♦• ) {** 
IRS-202 
J-l 

10 IU-J+20 

OPEN (ACCESS-* RANDOM' » RECORD SI ZE-I RS*UNIT-IU 
1* MODE-* BINARY** DEVICE- 'DSK' ,DISP0SE- * SAVE* ) 

C*************** is Lambda-J real? ****************************** 


READ ( IU* 1 > LRE ( J ) ,L IM ( J ) 

IF (ABS(LIM( J ) ) ,GT,ABS(ZERO) ) GO TO 30 
C*************** Find real VA-J-th column of IV) **************** 
READ ( IU ' 3 ) ((NL(II,IJ)»IJ-i*NI),II-i,NS) 

C CALL USWFM (10HMATRIX NL: , 10,NL»10,NS,NI,4 ) !** 

00 20 IV«1,NI 
X( I V )*XX ( I V , J ) 

20 CONTINUE 

C******** Fi n( j VA-INL 1*X and put it in J-th column of IV] ****** 
CALL VMULFF ( NL»X , NS ,N I , 1 , 10,20 ♦ VA , 20 , IER ) 

CALL UERTST ( IER,6HVMULFF I 

C CALL USWFV ( 10HVECT0R VA : , 10, V A,NS , l , 4) !** 

DO 25 IV*I,NS 
V(IV, J)-VA(IV) 

25 CONTINUE 

29 IF (J.GE.NS) GO TO 100 

J- J «■ 1 

GO TO 10 

C**************** Find complex VA's ***************************** 

30 INl-NI+1 
NI2-2*NI 


C 

C 


NS2»2*NS 

IN.'5-NS*1 

READ (IU'6) ( (QL( II, IJ) «IJ-1«NI2) ,11*1, NS) 

READ ( IU ' 7 ) ( ( RL( 1 1 • IJ ) , I J-i,NI 2 ) , 1 1 - 1 ,NS ) 

CALL USWFM (10HMATRIX QL : , 10 ,0L , 10, NS ,NI2 , 4 ) I** 

CALL USWFM ( 10HMATRIX RL: , 10,RL, 10 ,NS , NI2 , 4 ) !** 
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00C57 

00058 

00059 
00C60 
00061 
00062 
00063 
00C64 

00065 

00066 

00067 

00068 

00069 

00070 
00C71 

00072 

00073 

00074 

00075 

00076 

00077 

00078 

00079 
00C8 0 
00081 
00082 

00083 

00084 

00085 

00086 
00087 
00098 
00089 
00C90 
00091 
0009 2 

00093 

00094 



IOJ*l 

C*4*4** Form ISTAR] and double length X *♦*•*•**♦*♦♦*•♦*♦♦****** 
00 135 II»l»NS 
DO 135 IJ-ltNl2 
STARIMflJI-OUII.IJI 
135 CONTINUE 

00 140 II-INS»NS2 
DO 140 IJ>1*NI2 
IOUM-II-NS 

STARIII,! J>-RLIIDUH,IJ> 

140 CONTINUE 

C CALL USWFM I12HMATRIX STAR s ♦ 12 • STAR*20*NS2 • NI2*4> ! •♦ 

DO 40 IV-1,NI 
XUV)»XX(IV, J> 

40 CONTINUE 

DO 50 I V» IN I » N 12 
IVDUM»IV-NI 
X(IV)»XX( IVDUM,IC> 

50 CONTINUE 

C CALL USHFV ( 10HVECT0R XT:»10»X»NI2»1»4I !*♦ 

C***** Find VA«[*].X and partition It to IVlj, CV]j*l ***♦**♦*♦♦ 
CALL VMULFF C STAR « X » NS2 »NI 2 « 1« 20 t 20* VA, 20. IER » 

CALL UERTST ( IER .6HVMULFF I 

C CALL USWFV (10HVECT0R VA : * 10» V A »NS2 » 1 ♦ 4 1 !** 

DO 60 IV»1,NS 
V(IV, JI-VAIIV) 

IVD-IV+NS 
V(IV,IC)*VA(IVDI 
60 CONTINUE 

J*IC 

GO TO 29 

C**e*********** Print IV 1 ***•***********•♦****•*••♦•*••*♦* 

100 CONTINUE 

C CALL USWFM ( 11HMATR IX I V 1 S ,11* V,10*NS *NS» 4 1 !*♦ 


C WRITE (5» 2) ! ** 

C 2 FORMAT ( IX, 'EXITING DESIGN I !♦* 

RETURN 
END 
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00001 

00002 

00003 

00004 
00C05 
00006 

00007 

00008 
00009 
00CL0 
00011 
00012 

00013 

00014 

00015 

00016 

00017 

00018 
00019 
00G20 
00021 
00022 

00023 

00024 

00025 

00026 
00027 
0002 8 
00 02 9 
00 C 3 0 

00031 

00032 

00033 

00034 
00C35 
00C36 

00037 

00038 

00039 

00040 

00041 

00042 

00043 

00044 

00045 
0QC46 
00047 
00C48 

00049 

00050 

00051 

00052 

00053 

00054 

00055 

00056 

00057 

00058 

00059 
00C60 


*♦*♦*****++**+ +*♦+**♦*«♦*♦**+*+♦♦*♦**♦♦♦*♦**♦+ ♦++*♦♦*♦*+ 

C+ +++*+*+***+***+♦***+++**♦***++ +++***♦♦+♦♦+**+♦+***++♦*♦++* 

SUBROUTINE PFX ( I , J t IFLAG ) 

C-Function: Returns p(F]/p(x]ij • 

C-IMSL routines called: UERTST » LLSOF » VHULFF, (USWFN I . 

C-Spectral Assignment routines: INSTEP. j 

C-Logical devices; Input Unit: - Output Unit: (5) 

C- Storage Unit(s): - 

C-Random Access Files* - • 

C GRADIENT ARRAYAS 

REAL AUXM10.10) , AUX2 ( 10, 10 > , AUX3 ( 10, 10) 

C NULL SPACE APRAYS 

REAL ML(10,10I»NL(10»10),ALPHA(20»20)»BETA(20»20) 

REAL NLC(10,20),PLC(10,20),MLCI10,20) 

REAL. STAR (20, 20) .QL( 10.20 ) »RLC 10 ,20) 

C AUX. ARRAYS 

REAL UKAREA(I30),H(20) 

C MODE 3 ARRAYS 

REAL XX (10, 10) ,VA(20),E(20),X(20),LRE( 10 ) ,L I N( 10) ,WJ ( 10) 

REAL W(10»10)»V(10»1C)»VINV(10»10)»F(10*10> , AHAT (10,10) 

INTEGER l P A ( 20 ) 

REAL A(10,10),B(10,10) ,C(I0,10) 

C ONNON/SYS/A, B,C, ZERO, IOGT, NS.NI.NO 
COHMON/GIG/LRE,LIM 

COMNON/VEC/VA,E,X,WJ,W,XX,V,VINV 

CONMON/NSPA/NL,NL,NLC,PLC,HLC,STAR,QL,RL 

C0MM0N/AUX/AUX1,AUX2,AUX3 

C*************** Is Lambda-J real? ****************************** 

IF (ABS(LIM(J)).GT.ABS( ZERO) ) GO TO 30 

c , ************ Find part I a I s of J urt elements of [XXI* real case** I 

DO 15 II-l.NI j 

DO 15 IJ*1,NS I 

AUXMII.I J)-FLOAT(O) 

IF (IJ.EO.J) AUXKII.IJ )*— NL( 1 1 » I ) 

15 CONTINUE 

DO 20 1 1*1, NS 
00 20 IJ*1,NS 
AUX2(II,I J)-FLOAT(O) 

IF ( I J .EQ. J ) AUX2III,! J)*NL(Il,l) 

20 CONTINUE 

C CALL USWFN ( 7HI AUX 1 1 * , 7 , AUX1, 10, NI , NS, A ) !♦* 

C CALL USWFN (7H[AUX2J:,7,AUX2,10,NS,NS,4) !** 

CALL INSTEP 
IFLAG-0 
GO TO 499 

C**************** Find complex partials ************************* 

30 I S«NS+N I 

NI2*2*NI 
NS2»2*NS 
INS-NS*1 
JO-J 
JC-J*1 
INOW-I 

C**F** FORN [STAR], [ALPHA ], [BET A J **♦**♦♦♦♦*♦♦♦♦*♦♦***♦********• I 

DO 110 II-l.NS 
00 110 IJ-1.NI2 
STAR ( 1 1 , 1 J )*0L ( 1 1 , 1 J ) 

IDUN» 1 1 ♦NS 

STAR ( IOUN, I J ) «RL ( [ I , I J ) 

110 CONTINUE 
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00C61 

C 

CALL USWFN (12HMATRIX STARJ»12*STAR,20»NS2»NI2*4) !♦* 

00062 


DO 135 1 1 * 1 * NS 

00063 


DO 135 IJ»1,IS 

00064 


ALPHA* II, IJJ-NLC(II,IJI 

00065 

135 

CONTINUE 

00066 


DO 1 AO I I* I NS » NS2 

00067 


DO LAO IJ*1,IS 

00068 


IDUM-II-NS 

00069 


ALPHA ( 1 1 * I J )— PLC ( IDUM, I J ) 

00070 

140 

CONTINUE 

00071 

C 

CALL USWFM ( 14HNATRI X ALPHA :,14«ALPHA,20,NS2,IS,4) !*• 

00C72 


DO 185 II-ltNS 

00073 


DO 185 IJ-l.IS 

00074 


beta*ii,ij)-plc*ii,ij) 

00075 

185 

CONTINUE 

00076 


DO 190 II-INS,NS2 

00077 


DO 190 IJ-1,IS 

OOC78 


IDUM-II-NS 

00 079 


BETA* I I« I J) -NLC * IDUM* I J ) 

oooac 

190 

CONTINUE 

00081 

C 

CALL USWFM (13HMATRIX BETA t ♦ 13 ,3ET A , 20,NS2 , I S ,4 > !** 

00 082 

50 

CONTINUE 

00083 


DO 55 II-1,NS2 

OQ 08 4 


E*II J-STAR* II.INOW) 

00085 


VA*II )«STAR* II,INOW) 

00C86 

55 

CONTINUE 

00087 

C 

CALL USWFV ( 19HI-th column of £ * 1 s ,L9,E,NS2,1, A) !** 

0008 8 

C 

CALL USWFV * 19HI— th column of [*] : ,19,VA,NS2,1,4) !♦* 

00089 


CALL LLSQF ( ALPHA , 20 ,NS2 , I S, E .-1.0. IS ,X,H , IPA, IERI 

00C90 


CALL UERTST *IER,6HLLS0F ) 

00C91 

c 

CALL USWFV * 15HVECT0R ITN11-I : *15 * X , 1 S , 1* A 1 !*♦ 

00092 

c*+* 

Form E- t MLC ) *1 TM1 ) i and put E in J-th column of CAUXII ♦***♦ 

00C93 


CALL VMULFF *MLC,X,NI,IS,1,10,20,E,20,IER) 

00C94 


CALL UERTST ( IER .6HVMULFF) 

00095 

c 

CALL USWFV (LOHOUXII-J S , 10 ,E ,NI * 1 * A 1 !*♦ 

00096 


DO 180 IV-1,IS 

00097 


X * I V ) —FLOAT ( 0 I 

0009 8 

180 

CONTINUE 

00 099 


CALL LLSQF * BETA ,20 ,NS2 , IS ,VA,-1.0, IS ,X,H, IPA , IER) 

00100 


CALL UERTST UER.6HLLSQF t 

00101 

C 

CALL USWFV * 15HVEC TOR I TM2 l-I : , 15 , X , I S ♦ 1, 4 ) !*♦ 

00102 

C** 1 

form V s« [ MLC 1 TNI J i and put VA in J*lth column of IAUX1) *** 

00103 


CALL VMULFF * MLC ♦ X ,NI , t S , l ,10, 20, VA,20» IER ) 

00104 


CALL UERTST * I ER ,6HV MULFF ) 

00105 

c 

CALL USWFV (10HCAUXl]j+l:,10,VA,NI,l,A) ! ** 

00106 


DO 60 II«1,NI 

00107 

* 

DO 60 I J-1»NS 

00108 


AUXl * ! I , I J )«FLOAT( 0) 

00109 


IF (IJ.EQ.JO) AUX1* II, I J)»E( II) 

00110 


IF (IJ.EQ.JC) AUX1(II,IJ)— VA(II) 

00111 

60 

CONTINUE 

00112 

C 

CALL USWFM (8HIAUX1I : , 8, AUX1, 10,NI,NS,A) •** 

00113 


DO 70 I I-1«NS 

00114 


DO 70 IJ»i,NS 

00115 


AUX2 (II«IJ)*FL0AT(0) 

00116 


IF (IJ.EQ.JO) AUX2*It, I J)»QL( II.INOW) 

00117 


IF (IJ.EO.JC) AUX2(II,IJ)-RL{II,IN0W) 

00118 

70 

CONTINUE 

00119 

C 

CALL USWFM (8HIAUX2) ? ♦ 8 , AUX2 , 10,NS ,NS , 4 ) !** 

00120 


CALL INSTEP 

00121 


IF ( INQW.NE. I ) GO TO 999 


89 


oeu? 


IFLAG-l 

00 12 S 


DO 60 II-1«NI 

0012$ 


DO 60 IJ»1'NS 

0012 5 


UCIIfI JJ-AUX3C II.I J) 

00 12 6 

ao 

CONTINUE 

00127 


tNOW-l*NI 

00126 


CO TO 50 

00129 

999 

RETURN 

00130 


END 
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C*******?***************tt **+***«♦*+***♦************♦*********** 

C* **********************+*********+*******+* **************+****** 

SUBROUTINE M0DE7 

C-Functions Main routine for Sensitivity Reduction* 

C-IMSL routines called: UERSET ,UERTST,LINV2F,USWFM* 

C-Spectral Assignment routines: SEARCH, TRAN, SGRAO, SCOSTySENS* 

C-Logical devices; Input Unit: 5 Output Unit: 5 

C- Storage Unltls): IU-20,IUT»20*NS*1,IU-20*J for J*1,NS* 

C -'Random Access Files: SYSTEM. OAT, CURRNT.DAT, F0Rxx.DAT where xx*20*J. 

REAL WKAREAI 1301 ,0(10,10) 

C GRAOIENT ARRAYAS 

REAL LI 10), PI 10 1 ,DAD(10,10),DBD(10,10),DAH0(10,10) 

C NULL SPACE ARRAYS 

REAL ML 1 10, 10), NL 1 10,10) 

REAL NLC(10,20),PLCI10,20),MLCI10,20) 

REAL STAR(20«20)«QL(10,20) , RL 1 10 ,20) 

C MODE 3 ARRAYS 

REAL XX(10«10),VA(20)«E(20),X(20),LRE(10),LIM(10) ,WJI10) 

REAL MI10,10),V(10,10),VINV(10,10),F(10,10) , AHAT 110,10) 

REAL AI10,10),B(10,10),C(10,10) 

COMMON/SYS/ A, 8*C, ZERO, IOGT, NS, NI, NO 
COMMON/ AUG/ F, AHAT /E IG/LRE »LI M/WET/L»P/GR/G/SEN/DAD»OBD»DAHD/LEG/U 
COMMON/VEC/VA,£,X,WJ,W,XX,V,VINV 
COMMON/NSP A/ML, NL,NLC, PLC.MLC, STAR ,QL,RL 
EXTERNAL SCOST,SGRAO 
CALL UERSETI 3,LEVOLD ) 

IU-20 

READ (IU'l) NS,NI,NO,IOGT,ZERO 

READ I IU'2 ) l(A(II,IJ),IJ*l,NS),II*l,NS) 

READ 1IU'3 ) (fB(IT,IJ) , I J- 1 ,N I ) , 1 1 - 1 , NS ) 

IUT *20-*NS *1 

OPEN (FILE-'CURRNT. DAT*, ACCESS-' RANOOM • , RECORD SIZE-102 
1 , UN IT* IUT »MQDE« ' BINARY* ,0EVI CE*' DSK* ,DISPOSEVSAVE* ) 

READ I IUT * 1 ) I (VIII, IJ) ,IJ-1,NS) ,11*1, NS) 

READ IIUT'2) I (XXIII, IJ),IJ-l, NS), II-1,NI) 

READ I IUT ' 4 ) I (FI II, IJ) ,IJ-1,NS) ,II*1,NI) 

READ I IUT *5 ) 1 1 AHA T(II«IJ) , I J*1 «NS ), 11*1, NS) 

CALL USWFM (10HMATRIX V :, 10, V, 10, NS, NS, 4) !** 

CALL USWFM (10HMATRIX XX: , 10, XX, 10 , NI ,NS,4 ) !*♦ 

CALL USWFM (14HGAIN MATRIX F: , 14, F , 10, Nl ,NS ,4 I !** 

CALL USWFM I 12HMATRIX AHAT: ,12 , AHAT, 10 , NS , NS, 4 ) !** 

DO 30 J-lyNS 

IU-J+20 

IRS-202 

OPEN (ACCESS-'RANDON*, RECORD StZE-!RS»UNIT«IU 
l, MODE* * BINARY" ♦DEVICE*»DSK* ,DISPOSE*» SAVE* ) 

READ (IU*l) LREI J) ,LIM( J) 

30 CONTINUE 

WRITE (5,1) 

1 FORMAT I IX ,201 1H* ) ,30H MODE 7:SENSITIVITY REDUCTION ,20(1H*),// 

1,1X,23H Set weighting factors:,/ 

2,lx,34H Eigenvalue weighting factors are:) 

00 10 IV*1,NS 
LIIV)-FLOAT(l) 

WRITE (5,3) IV, LI IV) 

3 FORMAT (1X,2HL(,I2,2H)*,F15.6) 

10 CONTINUE 
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WRITE <5, 5) 

5 FORMAT ( IX* 15HWi sh to change?) 

READ (5*4) XL 

IF (KL.LE.O) GO TO 11 
READ (5*4 ) (L( IV ) * I V*l* NS ) 

II WRITE <5. 2) 

2 F-0RMAT ( IX* 34HE i genvec tor weighting factors are*) 

m 15 IV-1»NS 
P ( I V) *FL0AT ID 
WRITE C5* 4 ) IV,P(IV) 

4 FORMAT (1X,2HM(*I2*2H)-,F15.6) 

15 CONTINUE 

WRITE (5*5) 

REAO (5*4) KK 
IF (KK.LE.O) GO TO 20 
REAO (5*4) (P( IV) ,IV-1,NS) 

20 WRITE (5*6) 

6 FORMAT (lX,l4WEnter IdA/dP]:) 

READ (5*4) ((OAD(!I;IJ)tIJ»l*NS)*II»l*NS) 

WRITE (5*7) 

7 FORMAT (lX,14H6n£er IdB/dPJ:) 

READ (5*4) ( (080(11*1 J) . . I J-l.NI), I I*1«NS) 

CALL SENS 
IOG»IOGT 

CALL LINV2F ( V*NS*10,U* IOG.WKAREA* IER) 

CALL UERTST( IER.6HLINV2F) 

C CALL USWFM ( 10HMATR1X7UT: *10«U*10*NS*NS*4) !** 

CALL tran(U*NS*NS) 

C CALL USWFM ( 10HMATRIX7U s . 10, U, 10. NS. NS. 4) !*♦ 

CALL SCOST(CJ) 

CALL SGRAO 

CALL SEARCH(CJ,SC0ST*SGRAD,7) 

WRITE (IUT'l) ((V(II,IJ)*IJ«1*NS),II-1*NS) 

WRITE (IUT'2) ((XX(II.IJ) ,IJ«l*NS) ,II-l*NI) 

WRITE (IUT'4) ((F(II,IJ)*IJ-1*NS)*II>1,N() 

WRITE (IUT'5) ((AHAT(II*IJ),IJ»1*NS)*II-1*NS) 

CALL USWFM (10HMATRIX V : ,10, V, 10. NS. NS, 4) ! 4* 

WRITE (5,902) 

902 FORMAT (1X.44HWISH TO DISPLAY THE NORMALIZED EIGENVECTORS?) 

READ (5*4) KS 
IF (KS.LE.O) GO TO 903 
CALL DSPLAY (NS.ZERO) 

903 CONTINUE 

CALL USWFM ( 10HMATRI X XX* ,10,XX*10*NI *N$,4 ) J 4* 

CALL USWFM ( 14HGAI N MATRIX F* *14*F, 10.NI.NS.4) !*4 

CALL USWFM ( 12HMATRIX AHA T * *12 *AHA T, 10 *NS * NS ,4 ) *44 

RETURN 
END 
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C**** ********************* •*>+******+*****+***+*+ 1 *+ ***** **« *+** 

C* ************ ♦•*♦•*♦*'+****♦♦♦*•♦•♦•♦♦ + **+**•'♦♦*♦♦♦♦* + + +*+ + *♦ + 

SUBROUTINE SCOST(CJ) 

C-Funetlon: Calculates the COST function for Sensitivity Reduction* 
C-IMSL routines called: (USWFM). 

C-Spectral Assignment routines* ZK* and Function routine T • 
C-Logical devices; Input Unit* — Output Unit: 5 

C- Storage Unites): - 

C-Random Access Files: - 

REAL V{10,10>*U{i0,10>,LU0>,P( 10) 

REAL VJtlO),VJl(lO>,U'i(10),UJl(10),LRE(lO)*LIH(10) 

REAL XXt 10»10I,VA(20),E(20),X(20),WJ(10I 
REAL WU0,10),VINVU0,10> 

REAL A(L0,10)«B( 10*10) »C(10»10) 

INTEGER 0 

COMMON/$YS/A*B»C,ZERO,IDGT*NS,NI,NO 

COMMON/EIG/LRE,LIN/WET/L»P/LEG/U 

COMMON/ VEC/ VA, E,X,WJ,W, XX* V, VI NV 

CJ1-FL0AT10I 

CJ2-FL0AT(0) 

DO 100 J«1,NS 
JC-J+1 
RELJ-LREC J) 

XINJ-LIMI J) 

C WRITE 15*1) LREC J) ,RELJ*LIM( J),XIMJ 1*4 

& 1 FORMAT ilXt’LREC J)«REL J* *2F15,6« 'L IM( JI-XIMJ* ,2F15.6) ! ** 

DO 10 IV*1,NS 
VJ1UV l-FLOAT(O) 

U Jl( IV )*FLOAT( 0) 

VJ(IV)«V(IV,J> 

UJ(IV)-U( IV, J) 

IF (ABS(XIMJ).LE.ABSiZERO) ) GO TO 10 
VJlUV)-V(IV,JC) 

UJH IV)-UUV,JC> 

10 CONTINUE 

c CALL USWF V ( 11HVECTCR VJ:,11, VJ, NS, 1,4) !** 

C CALL USWFVCHHVECTQR VJl: ,ll,VJl,NS, 1,4) !*4 

c CALL USWF V( 1 1HVECY0R UJ?,11, UJ*NS*1*4) !*4 

c CALL USWFVUlWVfcCTOR UJ 1 : ,il*UJ7,*NS*l*4) !** 

IF (ABSIXIMJI.LE.A&SIZERO) ) GO TO 20 
CJi-CJl + M JI4C CT C l»VJ,UJ)-T( 1,VJ1,UJ1))**2*(T(1,VJ1,UJ)+ 
1T{1,VJ,UJD 1**21 
GO TO 30 

20 CJl-CJl+L(J)*T( l»VJ*UJ)**2 

30 SUM-FLCAT(O) 

00 50 IQ-1, NS 

Q-lQ 

NJ-J 

CALL ZK(Q,NJ,RELJ,XIMJ,ZRE,ZIM) 

SUM«SUM+ZRE**2+ZIM**2 
50 CONTINUE 

CJ2-CJ2+PI J)*SUM 
100 CONTINUE 

CJ-CJ1+CJ2 

WRITE (5,2) C J1«CJ2 

2 FORMAT (1X,3HJI-,F15.6,5X,3HJ2-,F15.6) 

RETURN 

END 
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C******* ******** ******************************************* 

C******* ****************************************** ********* 

SUBROUTINE SGRAD 

C-Function: Calculates the Gradient for Sensitivity Reduction* 
C-IHSL routines cal led: UERTST »LINV?,F»VMULFF,USWFM» 

C-Spectral Assignment routines: PU»DBNORH»PFX, ZK» FRACiFunct lt\n T* 
C-Logical devices; Input Unit: - Output Unit: 5 

C- Storage Unitlsi: IU»20*J for J-1,NS. 

C-Random Access Files: F0Rxx.dat where xx»20*J« 

C GRADIENT ARRAYAS 

REAL G(10,1Q)*U(10»10)»PJI(10,10)»PJ2(10»10),L(10),P(10) 
REAL VJ(IO) ,VJm0),PVJX(10)*PVJXi(10),PV.JlX(i0)«PV JlXi(iO) 
REAL UJ( 10),UJi(10),PUKX(10),PUKXl(10),PUKiX(iO)»PUKlXl (10) 
REAL VM(10) ,VM1(10) ,UK( 10) ,UK1( 10) 

REAL PUR(10,10),PUC(10,10),PUC1(10,10) 

C NULL SPACE ARRAYS 

REAL ML(10,10),NL(10,10> 

REAL NLC(10,20),PLC(10,20) »NLC (10*20) 

REAL STAR (20,20) ,QL( 10»20 ) ,RL( 10*20) 

C AUX. ARRAYS 

REAL WKAREA ( 130 ) 

C MODE 3 ARRAYS 

REAL XX ( 10,10) ,VA(20) ,E(20) ,X ( 20 ) ,LRE ( 10) ,LIH( 10) ,WJ ( 10) 

REAL W( 10,10) ,V( 10,10 ),VINV( 10,10) 

REAL AUX1(10,10) ,AUX2( 10, 10) , AUX3 ( 10,10) ♦ AUX4( 10, 10 1 
REAL 0AD(10, 10), 030(10, 10), DA HD (10, 10) 

INTEGER 0,FLK,FLJ,FLM 

REAL A(10,10),B(10,10),C(10,10) 

COMNON/SYS/A,B,C,ZERO»IDGT,NS»NI»NO 

C0MH0N/EIG/LRE,LIN/GR/GZLEG/U/HET/L,P/PJ/PJ1»PJ2 

Common/vec/va,e»x»nj,w»xx»v»vinv 

COMMON/NSPA/ML »NL» NLC, PLC , MLC , STAR»QL» RL 

COMMON/ AUX/AUX1,AUX2»AUX3/SEN/ DAO, DB0,DAHD/AAUX/AUX4 

igt-idgt 

CALL LINV2F ( V, NS, 10, VINV, 16T, WKAREA, IER) 

CALL UERTST ( IER,6HLINV2F) 

C CALL USWFM 1 12HMATRIX V INV : ,12 , VINV,10,NS,NS,4) ! ** 

IRS-202 
J-l 

10 FL J*0 
IU-J+20 
RELJ«LR6( J) 

XIMJ»LIM( J) 

IF ( ABS(LIM( J) ) .GT. ABS( ZERO) ) FLJ-l 
IF (FLJ.EQ.l) GO TO 12 
DO 11 IV-1,NS 
VJ( IV)«V( IV, J) 

UJ( IV)-U( iy , J ) 

VJKIV)-FLOAT(O) 

UJKIV)»FL0AT(0) 

11 CONTINUE 

READ ( IU ' 3 ) ((NL(II,IJ),IJ-l,NII,II»l,NS) 

REAO ( IU ' 4 ) ((ML(n,IJ),IJ-l,NI),II-l,NI) 

C CALL USWFM ( 10HMATR IX ML: ,10,ML,10,NI ,Nl,4 ) !** 

C CALL USWFM (10HMATRIX NL 8 , 10, NL, 10 ,NS,NI ,4 ) <*♦ 

GO TO 14 
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12 


13 

14 


C 


114 

C 

c 

115 


15 


216 


NI2-2*NI 
IS«N5*M 
READ (IU*3) 
READ (IU'A) 
READ ( IU* 5 ) 
READ ( IU ' 6 I 
READ ( IU ' 7 ) 
JC»M 


((NLC(IItlJ)f IJ-lylSIyll-lyNS) 
KPLCI IIyIJ)yIJ-ly IS)yII*lyNS) 
(CMLCI II* I JJ , I J«lyIS)ylI-lyNI) 
( ( QL ( 1 1 y I J ) y IJ*lyNI2ly 1 1 ■ltNS) 
I(RL( IlylJI y I J-lyNI2)yI 1-lyNS) 


DO 13 IV*1,NS 

VJKIVI-VCIVyJCI 

UJKIVI-UUV, JCI 

CONTINUE 

DO 110 I-lyNI 

KI-I 

KJ-J 

CALL PFX(KIyKJylFLAG) 

CALL VMULFF(DBDyAUX3yNS,NIyNS,10,10, AUXAylOylERI 
CALL UERTST ( IER,6HVf1ULFF ) 

CALL USWFH ( 12HMATRIX AUXA : y 12y AUXA y lOyNS y NS y A I 
IF (FLJ.NE.l) GO TO 115 

CALL VMULFFlDBOyWyNSyNIyNSylOylOyAUXAylOy IER) 
CALL VMULFFt DBOy AIJX3yNSyNI yNSy lOylOy Wy 10, IER) 
CALL UERTST ( IER ,6HVMULFF ) 

DO 11 A II-lyNS 
DO 11A IJ-lyNS 
AUX3(IltIJ)-WiIIyIJ) 

CONTINUE 

CALL USWFH (12HHATRIX AUX A : y 12 y AUXA y lOy N$y NSy A ) 
CALL USWFH (12HNATRIX AUX3 ! y 12 y AUX3 y 10 yNSy NSy A ) 
IF (FLJ.EQ.ll GO TQ 16 
DO 15 IV-1,NS 
PV JX ( I V )*NL( IV, I) 

00 15 IW-ltNS 
WItVy IWI-FLOAKO) 

IF (IW.EQ.J) W( I Vy I W)»NL ( IVy I ) 

CONTINUE 
CALL PU(PUR) 

TERH*FLOAT 1 0 ) 


FLM-0 

DO 116 M*1,NS 

IF (ABS(LIH(M)).GT.A3SIZER0)I FLH-1 


! *■* 


!** 

!♦* 


HC-N+1 

DO 216 IV*1,NS 
VM( I V ) * V ( IVyM) 

UK( IV)-U( IVyM) 

PUKX (lV)»PUR(IVyM) 

VMK I V )*FL0AT(0) 

UKKIV)-FLOAT(O) 

PUKiXl IV)»FL0AT(0) 

IF (FLP.N6.il GO TO 216 
VMK IV)-V(IV,MC) 

UK1( IVI»UfIV,MCI 
PUK1X(IV)-P,UR(IV,MC) 

CONTINUE 

IF(FLM.EQ.l) GO TO 316 

TERM*TERM*L(M)*(T(2yVMyUK)+T(lyVNyPUKX))AT (l»VNyUK I 


! 
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GO TO 116 

316 TEPM»TERM«-L(M)*< ( T < 2 , VM,UK )-T( 2 , VM1 ,UK1 X-TIl ,VH,PUKX ) -T( 1 ,VM1,PUKI 

ixi mm*v*tUK»-T< i»vMi*uKnmT<2,VH,uKi>+n2tV«itUK>4n i,vm,puki 

2XMYtUVPl,PUKXn*<T(ltVMl»UK>*TU.VM»UKim 
C WRITE If.,*) TERM !*♦ 

116 CONTINUE 

PJKI* Jt«24(L( J)4T(l»PVJX*UJ)4m*VJ»UJ)«TERN) 

C WRITE (5,201) I,J,PJ1(I,J> !** 

C 201 FORMAT I iX.’GGGGGG * 1 2»* . 12, »P Jlf I • J )•* *F 15.6 1 !*♦ 

GO TO 20 

16 INI«I*M 

00 17 IV-l,NS 
PVJX(IV)-OL( IV, I) 

PVJX1 ( IV)«QL( IV, INI) 

PVJIXt IV)-RL< IV, I) 

PVJ1X1 ( I V )*RL ( IV, INI) 

00 17 IW-1,NS 
WCIV, IW)-FLOAT(O) 

IF (IW.EQ.J) W( IV,1W)-QL(IV,I) 

IF (IW.EQ.JC) W(IV,IW)-RLCIV,I ) 

17 CONTINUE 
CALL PU(PUC) 

TERN-FLOAT(O) 

FLN-0 

00 117 M»1,NS 

IF (FLN.EQ.ll GO TO 317 

FLH-0 

NC*M«-1 

IF (A8S(LIM(M) ) .GT.ABSIZERO) ) FLM-l 

oo 217 :v»i,ns 

VMUV)«V< IV, M) 

UK ( 1 V ) «U ( I V » M ) 

PUKX(IV)-PUC< IV, M) 

VMK IV)-FLOAT(O) 

UK1( IV)-FLOAT(O) 

PUKIXC IV)-FLOAT(O) 

IF (FLM.NE.L) GO TO 217 
VM1UV)-V(IV,MC) 

UKU IV)-U< IV, MC) 

PUK1XI IV)«PUC< IV, MC) 

217 CONTINUE 

IFIFLM.NE.l) TERM* TERM ♦L(M)*(T(2»VM»UK)*T(1*VM»PUKX))*T(1»VM»UK) 

IF (FLM.NE.l) GO TO 117 

TERN-TERK*L(M)*( <T( 2 , VM, UK )~T( 2 * VM1 , UK 1 ) *T( l » VM,PUKX ) -T { 1 ,VM1 
1 , PUKIX) )*IT(l,VM,UK)-m,VMl,UKl ) ) ♦ ( T I 2 , VM,UK 1 J + T ( 2 , VM 1 ,UK) 
2>TC1,VM, PUK 1X)*T(1,VMI,PUKX) ) *( T 1 1 « VMl »UK ) *t (1, VM,UK1 ) ) ) 

GO TO 117 

317 FLM*0 

117 CONTINUE 

P J1(I,J)*2*(L( J)*( <TC1,PVJX,UJ)-T(1,PVJIX,UJ1))*(T(1,VJ,UJ)- 
IT(1,V J1,UJ1) )*(m,PVJX,UJl)->T(l,PVJlX,UJ) )*(T( 1,VJ1,UJ)+ 
2T(1,VJ,UJ1) ) ) ♦TERM) 

00 18 IV-1,NS 
00 18 IW-UNS 
WIIV, IW)* FLOAT (0) 

IF MW.EU.J) W< IV, IW)-QL( IV, INI ) 


96 


00169 

00170 

00171 

00172 

00173 

00174 

00175 

00176 

00177 

00178 

00179 

00180 
00181 
00182 

00183 

00184 

00185 

00186 

00187 

00188 

00189 

00190 

00191 

00192 

00193 

00194 

00195 

00196 

00197 

00198 

00199 

00200 
00201 
00202 

00203 

00204 

00205 

00206 

00207 

00208 

00209 

00210 
00211 
00212 

00213 

00214 

00215 

00216 
00 217 
00218 

00219 

00220 
00 221 
00222 

0 0223 

00224 
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IF (IW.EQ.JCI W(IV,IW)«RL(1V,IN1) 

18 CONTINUE 

CALL PU(PUCl) 

TERM-FLOAT(O) 

FLM-0 

00 118 M»1,NS 
IF (FLM.EQ.l) GO TO 318 
FLM-0 
HC-M*1 

IF ( ABS(LIM(fD).CT.A0S(ZEROn FLM-l 
00 218 I V- 1 » NS 

v.it m«v< iv, m) 

UK< IV)«U( IV, M) 

PUKXK IV)-PUC1< IV, M) 

VNlf I V )-FL0AT(0) 

UK1< IV)-FLOAT(O) 

PUKIXKIV)-FLOAT(O) 

IF (FLM.NE.l) GO TO 213 
VMl(IV)«V(IV t NC) 

UK1< IV|-U(IV,NC> 

PUK1X1CIV J-PUC1(IV,MC> 

218 CONTINUE 

IF (FLM.NE.l) TERf1-TERM*L(N)*(T(3,VM 
IF (FLr-NE.ll GO TO 118 
TERM-TERH«-LtMJ*( ( T ( 3 , VM, UK )-T ( 3 ♦ VM1 
1»PUK1X1))*(T(1,VH»UK)— T(1»VM1»UK1)) 

2*T( 1,VM,PUK1X1)*T( l,VMl,PUKXi) )*(T( 

GO TO 118 
318 FLM-0 

118 CONTINUE 

PJ1(I, JC)-2* (LUC) *( (T(1,PVJXI,UJ)-T(1,PVJ1X1,UJ1))*(T(1,VJ,UJ)- 
lT(l,VJl,UJl))MT(i,PVJXl»UJl)+T(l»PVJlXl»UJ))*(T(l*VJl,UJ) + 
2T(l»VJ,UJi)))*TERM) 

PJ2< I, JC)-FLOAT(O) 

20 P J2( I ,J)-FLOAT (0) 

M-l 

40 FLM-0 

MC-M+1 

IF (ABS(LIM(M) ) • GT . ABS ( ZERO ) ) FLM-1 
00 45 IV»1,NS 
VM( IV)-V( IV, M) 

VMK IV)-FLOAT(O) 

IF (FLM.EQ.l) VMK IV)-V1 IV.MC) 

45 CONTINUE 

TERM1-FL0AT ( 0 ) 

TIMl-FLOAT(O) 

TERMli-FLOAT(O) 

T I Mil -FLOAT ( 0 ) 

SUMQl-FLOAT ( 0 ) 

SUM02-FL0 A T ( 0 ) 

00 30 Q-l »NS 
K 0-Q 

IF (M.EO.J) GO TO 50 

voj-via, j) 

VOJl-FLOAT (0) 

IF (FLJ.E0.1) VQ Jl* V( 0, JC I 


,UK)«-T(1,VM,PUKX1) )*T( l,VM,UK) 

,UK1)+T( 1,VM,PUKX1)-T( l.VMl 
♦'(T(3»VM»UK1)*T(3»VMI»UK) 
l»VMl,UK)-»T(l»VM»UKi)) ) 


00225 

00226 
00 22 7 
00228 

00229 

00230 

00231 

00232 

00233 

00234 

00235 

00236 

00237 

00238 

00239 

00240 

00241 

00242 

00243 

00244 

00245 

00246 

00247 

00248 

00249 
002f 0 

00251 

00252 
0025 3 

00254 

00255 

00256 

00257 

00258 

00259 

00260 
00261 
00262 
0026.3 

00264 

00265 

00266 

00267 

00268 

00269 

00270 

00271 

00272 

00273 

00274 

00275 

00276 
0027 7 

00278 

00279 

00280 
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IF (FLJ.EO.l) GO TO 48 
P0JX«NL(Q, I » 

POJIX-FLOAT(O) 

GO TO 49 

48 PQJX-OL(Q,I) 

PQJIX-RL(Q,I) 

PQJX1»QL(Q,INI) 

PQJLX1*RL(Q,INI) 

49 CALL FRAC(KQ»KJ*M»LRE(M)»LlM(M)»l»UJ» 
1TERH1.TIM1) 

C WRITE (5,202) TERM1 ,FRE ,TIMl,F IM,J, I , 

C 202 FORMAT (IX, • TERMUFREtTIMlfFIM* ,4F15. 

IF (FLJ.NE.l) GO TG 50 
CALL FRAC(KO,KJ,M,LRE(M),LIM(M) ,1,UJ, 
ITERM11, TIM11) 

50 CONTINUE 
TERM2«FL0AT(0) 

TIH2-FL0AT(0) 

TERM2i-FL0AT(0) 

TIM21«FL0AT(0) 

K-i 

51 FLK-0 


KC-K+1 








IF 

( ABS (L IM( K 

n.GT 

.AdS 

(ZERO! 

1 ) 

FLK 1 

IF 

(FLK. 

NE. 

1. 

4N0.K 

.EQ. 

M ) GO 

TO 

58 

IF 

( FLK • 

EQ. 

1. 

AND .K 

.EQ. 

H ) GO 

TO 

57 

00 

52 IV 

-if 

NS 






IF 

(FLJ. 

NE • 

1) 

PUKX 

CIV) 

■PUR (IV, 

K) 

IF 

( FL J. 

EQ. 

I) 

PUK X 

( IV) 

»PUC(IV, 

K) 


PUKIX( IV)-FLOAT(O) 

IF (FLK.EQ.l.ANO. FLJ.NE.l) PUK1X ( I V )»PUR( I V ,KC ) 

IF (FLK.EO.l.ANO.FLJ.EO.l) PUK IX ( I V ) «PUC ( I V ,KC » 

PUKXK IV)»FLQAT(0) 

IF (FLJ.EQ.l) PUKXK IV)*PUC1( IV, K) 

PUK1X1(IV)*FL0AT(0) 

IF (FLK.EO.l.ANO.FLJ.EO.l) PUKIXK IV )«PUC1 ( IV,KC) 

UK( I V J »U ( IV, K) 

UKK I V )*FLQAT (0 ) 

IF (FLK.EQ.l) UK1( IV)«U( IV,KC) 

52 CONTINUE 

VQK* V ( 0 ,K ) 

VOK 1«FL0A T ( 0 ) 

IF (FLK.EQ.l) V0K1»V(0,KC) 

CALL FRAC(K0,K,M,LRE(M) ,LIM(M) ,1,PUKX,PUKIX, 

IFREKFIMI) 

CALL FRAC(KQ,K,M,LRE (M),LIM(M) ,2 , UK , UK 1 , VM , VM 1 
C WRITE (5,204) TERM2 ,FRE ,T I M2,F I M , J , I , M , 0, K 

C 204 FORMAT ( IX , » TERM2 , FRE, T I M2 , F I M • ,4F 15 . 6 , / , l'X , 
TERM2*TERM2+FRE+FRE1 
TIM2*TIM2+FIM*FIMl 
C WRITE (5,204) TERM2 , FRE , T I M2,F I M , J , I , M, 0, K !+* 

IF (FLJ.NE.l) GO TC 57 

CALL FRAC(KQ,K,M,LRE(M),LIM(M),1,PUKX1,PUK1X1,VM, VM1,V0K, 
IVQK1»FRE1,FIM1 I 

CALL FRAC(KQ,K,M,LRE(M),LIM(M),3,UK,UK1,VM,VM1,V0K,V0K1,FRE,FIM) 
TERN21-TERM2DFRE+FRE1 


VM,VM1,VQK, VQK1, 

,VQK,V0K1,FRE,FIM) 

! ** 

• J,I,M,0,K* ,512) l** 


UJI,VM,VM1,PQJX,PQ JIX, 

M, Q !** 

6,/,lX,'J,I,M,Q',4 12 ) ! M 

UJ1,VM,VMI,P0JX1,P0JIXI, 
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00201 


TIM21*TIM21*FIM*FIN1 

00282 

5? 

IF (FLK.EQ.l) K*K*1 

00293 

58 

IF (K.EQ.NS) GO TO 60 

00264 


K-K+l 

00285 


GO TO 5L 

C0286 

60 

CONTINUE 

0028? 


TERM3»FL0AT<0» 

00299 


TIM3-FL0ATC0) 

00289 


TERM31«FL0AT(0) 

00290 


TIM31-FL0ATI0I 

00291 


IF (M.NE.J) GO TO 70 

00 292 


K»1 

00293 

61 

FLK-0 

00294 


KC-K+l 

00 29 5 


IF (ABS(LIN(K)).GT.ABS(ZERO)) FLK-1 

00296 


IF (FLK.NE.l.AND.K.EO. J) GO TO 68 

00297 


IF (FLK.EQ.l.ANO.K.EQ. J) GO TO 67 

00298 


00 62 IV-1,NS 

00299 


UK ( IV)-U( IV, K) 

00 300 


UKU IV)-FLOAT(O) 

00301 


IF (FLK.EQ.l) UK1(IV)»U(IV,KC) 

00302 

62 

CONTINUE 

00303 


VQK*V(G,K> 

00304 


VQKI*FL0AT(0) 

00305 


IF (FLK.EQ.l) VQK1»V(0,KC) 

00306 


CALL FRAC(KQ»K»J,LRE(J)»LIM(J)»l»UK»UKl,PVJX,PVJlX,VOK,VQKl,FRfc 

00307 


l*F IN) 

00308 

C 

WRITE 15,205) TERM3»FRE »TI N3*F IH » J ,I,N,Q,K ! ** 

00 309 

C 205 

FORMAT (IX^TERNa^FRE^TINatFIN* ♦4F15.6,/,1X,' J,I,N,Q(K' ,512) !** 

00310 


TERM3-TERM3+FRE 

00 311 


TIN3-TIM3+FIN 

00312 

C 

WRITE (5,205) TERM3*FRE »TIN3*F IN* J* I , N,Q,K ! ** 

00313 


IF (FLJ.NE.l) GO TO 67 

00314 


CALL FRAC(KQ,K,J,LRE(J),LIN(J),I,UK,UKI,PVJX1,PVJ1X1, VQK, VQKi, 

00315 


IFRE,FIN) 

00316 


TERM3l*T£RN31+FRE 

00317 


TIN31-TIM31+FIM 

00318 

67 

IF (FLK.EQ.l) K»K-*1 

00319 

68 

IF (K.EQ.NS) GO TO 70 

0032C 


K-K+l 

00321 


GO TO 61 

00322 

70 

CONTINUE 

00323 

C 

WRITE (5,206) TERfll , TE RM2, TERM3 , T I Ml , T I M2 , T I M3 ! +* 

00324 

C 206 

FORMAT ( IX, 'TERM l»TERM2»TER M3 »TIMI,TIM2»TIN3 , »/»1X»6F 15.6) ! *♦ 

00325 


PZXRE=*TERM1«-TERM2«-TERM3 

00326 


PZXIN«TIMI+TIM2»TIM3 

00327 


CALL ZK (KQ,M,LP.E(N),LIN(N),ZRE,ZIN) 

00329 

C 

WRITE (5,207) SUMQ1 ,ZRE , PZ XRE , ZI M , P ZX I N , J , I ,M, 0 • 

00329 

C 207 

FORMAT (1X,'SUN01,ZRE,PZXRE,ZIM,PZXIM',/,1X,5F15.6, * J , I ,M , Q * , AI 2 ) ! * 

00330 


$UMQI»SUMQ1*'ZRE*P ZXRE+Z I M* PZX I M 

00331 

C 

WRITE (5,208) SUMQ1 , J, I ,M,Q ! ** 

00332 

C 208 

FORMAT (1X,'SUM01«',F15.6,'J,I,N,Q',4I2) ! ♦* 

00333 


IF (FLJ.NE.l) GO TO 80 

00334 


PZXRE-TERM11 + TERM21«-TERM31 

00335 


PZXIN»TIMll*TIH21+TIM3l 

00336 


SUM02*SUNQ2*ZRE+PZXRE*Z IM*PZXI M 
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00337 

80 

CONTINUE 

00 338 


PJ2( I* JI-2*P(MJ4SUNQ1>PJ2(I»4) 

00339 


IF (FLJ.EO.l) PJ2(I»JC)“2*P(HC) *SUMQ2+P J2 < I « JC ) 

00390 

C 

WRITE (5.203) H, l * J.PJ2I I , J) !** 

00341 

C 203 

FQRNATUX.'-- N-* »I2» , --I-» *12. •*»J" , .I2» , P J2( I* J)-* .F15.6) 

00342 


IF (FLM.EQ.l) M«M+1 

00343 


IF (M.EQ.NS) GO TO 110 

00344 


«■*♦! 

00345 


GO TO 40 

00346 

110 

CONTINUE 

00347 


IF (FLJ.EO.l) J-JC 

00348 


IF (J.EQ.NS) GO TO 120 

00349 


J«J*1 

00350 


GO TO 10 

00351 

120 

DO 130 II»i.NI 

00352 


DO 130 IJ«i,NS 

00353 


G C 1 1 • I J)-PJ1(II.IJ)+PJ2UI,IJ) 

00 354 

130 

CONTINUE 

00355 

C 

CALL USWFM (llHMATBIk [ G] : * lit G* 10. NI « NS. 4 I !♦♦ 

00356 


CALL DBNORN (NI*NS) 

00357 


CALL USWFM (16HGradlent matrix: .16.G.10.NI.NS.4) !♦* 

00358 


RETURN 

00359 


ENO 


ORIGINAL PAGE IS 
OF POOR QUALITY 


00001 

00002 

oocoa 

00004 

00005 

00006 

00007 

00008 
00009 
00C10 
00C11 
00012 
00013 
00 Cl 4 
00015 
00C16 
00C17 
00018 

00019 

00020 
00021 
00022 

00023 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 
00C36 

00037 

00038 

00039 

00040 

00041 

00042 

00043 

00044 

00045 

00046 

00047 

00048 
00049’ 
00050 
00C51 
00 052 
00053 
00C54 

00055 

00056 


C*** ************ ******** ♦ * *********************** ************ 

C******* **************************************** ************* 


SUBROUTINE ZK ( Q , J » REL J , X I M J ,ZRE » ZI M ) 

C-Function: Expression evaluator for Mod* 7. 

C-IMSL routines called: - 

C-Spectral Assignment routines: COMOIV* and Function T. 
C-Logical devices; Input Unit: - Output Unit: (5) 

C- Storage Unit(s): - 

C-Random Access Files: - 


REAL V(10,10),U(10,10> 

REAL VJ( ], Q ) » V J1 ( LO ) , UK ( 10) , UKl ( 10 ) *LRE ( 101 *L1M ( 10) 

REAL XX C 10 » 10) ,VA(20),E(20)*X(20),WJ(10) 

REAL W ( 10 » 10) » V IN V ( 10*10) 

REAL A(10,10)«B( 10*10) «C(10,10) 

INTEGER Q,FLJ,FLK 

CQMNON/SYS/A*B*C*ZERO* IOGT*NS*NI*NO 

COMMON/E I G/LRE *L I H/LEG/U 

COMMON/ VEC/YA, E* X,WJ,W, XX, V, VI NV 

FLJ-0 

FLK-0 

JC«J*1 

ZRE-FLOAT(O) 

ZIM-FLOAT(O) 

IF (ABS(XIMJ).GT.ABS(ZERO) I FLJ-1 
DO 900 K*i » N$ 

IF (FLK.NE.l) 00 TO 10 
FLK»0 
GO TO 900 
10 CONTINUE 

C WRITE (5,3) J«K,LRE(K)*LIM(K) ! ** 

C 3 FORMAT (IX,' J- ' * 1 2 , r K* # , 1 2* »L AMBO A-K • ,2F 15.6 ) 

IF (ABS(LIM(K) ).GT.ABS(ZERO)) FLK*1 
IF (K.EQ.J) GO TO 900 
KC*K ♦ l 


100 



00 100 IV»l,NS 
VJK IV )-FL0AT(0) 

VJ(IV)«V( IV*J) 

IF (FLJ.EQ.l) VJK IV)-V(IV 
UK( IV)»U( IV, K) 

IF (FLK.EQ.l) UK1C IV)»U( IV 

CONTINUE 

VQK»V(C,K) 

VQKl-FLOAT(O) 

CALL USWFV( 11HVEC TOR VJ:, 
CALL USWFVl 11HVECTGR VJl:, 
CALL USWFV( 11HVFCT0R UK:, 
CALL USWFV( 11 HV ECTOR UK1:, 
WRITE (5,2) 0,K, VGK, VQK1 

FORMAT ( 1X,2H0», I2,2HK»,I2 
IF (FLK.EQ.l) VQK 1*V ( 0 *KC ) 
IF (FLJ.NE.l. AND. FLK.NE.l) 
TRR»T ( 1 , V J , UK ) 

TCC-FLOAT(O) 

IF (FLK.EQ.l) TCC-T(1,VJ1, 

TRC*T(l,VJl,UK) 

TCR-FLOAT(O) 


*JC) 


tXCI 

lit VJ,NStit4> 

! ** 

lit VJltNSf It 

!♦* 

lit UKtNSflfA) 

! *♦ 

1 1 1 UK It NS 1 1 1 4 ) 

! ♦* 


,4HVCK*,F15.6»5HVQK1«,F15.6) 
GO TO 200 

UK1 ) 


!♦* 


» 


00057 

0005 8 
00059 
00C60 
00061 
00062 

00063 

00064 

00065 
00C66 
00067 

0006 8 

00069 

00070 

00071 

00072 

00073 

00074 
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IF (FLK.EO.l) TCR-T(L,VJ,IJKi> 

C WRITE (5,4) K, J,TRR,TCC,TRC»TCR !♦* 

C 4 FORMAT (IX, » K*'t 12,' J-»» I2t*TRR ,TCC- 

C l *TCR',/,27X,4F15.6) !*• 

Ai*( TRR-TCC )*VQK— (TRC*TCP)*VQKl 
Bl"(TRC*TCR) *VQK*( TRR-TCC ) *V0K1 
A2*REL J-LRE ( K ) 

B2«LIf1(K)-XIMJ 

CALL C0H0IV(Al,ai,A/.>,B2,A3,B3) 

2RE-2RE+A3 
2 IH»Z l M*B3 
CO TO 900 

200 2RE*ZRE+(T(l»Vj,UK)*VQK)/( REL J-LRE IK)) 

900 CONTINUE 

C WRITE (5,1) 0, J»ZRE»ZIM !♦* 

C 1 FORMAT (1X,1H2,I2, 12,6H * ZRE-,F15.6,6H: ZIM-,F15.6) !** 

RETURN 
ENO 


-,TRC 


102 
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00C01 CM****** MM*M******M *********** MCMMe ♦*♦****♦**♦•**♦♦••*** 

00002 C**** *♦*♦•♦ ****♦♦•♦♦♦*♦♦♦♦♦♦•*♦•♦♦♦♦***♦***♦♦♦♦*♦•♦•♦*♦♦♦• ****** 

00 CO 3 SUBROUTINE PU(PUMAT) 

0000* C-Functlon: Returns IPUNATI-pIUl/plX J . 

00G0S C-IHSL routines called: VNULFF »UERTST» I USWF V tUSWFM ) • 

00006 C-Spectr a I Assignment routines: TRAN* 

00C07 C-Logical devices; Input Unit: - Output Unit: (5) 

00008 C- Storage Unit' t ^M - 

00009 C-Randoie Access Files: - 

00010 REAL XX< 10»10) ,VA(20),E<20) »X<20) tWJilQ) 

OUCH REAL W(10tl0l*VINV(lOfl0l»VC10»I0)»VECT0R(lO! 

00012 REAL Aa0,I0»fB<10*l0l»Cli0ti0l 

00013 REAL AUXlllOtlOl * AUX2<10»10> » AUX 3 C L0 t 10) «PUMAT ( 10, 101 

QOCIA COMNON/SYS/A»B,C»ZEROt IDGT ,NS ♦ NI »N0 

00015 CON«ON/VEC/VA*EtX,WJ,M,XX,VtVINV 

00016 COHNON/AUX/AUXi»AUX2,AUX3 

00017 C WRITE I5*L1 J i** \ 

00018 C l FORHAT <IX» ' SUBROUTINE PU, J-SI2I !*♦ I 

00019 C CALL USWFN llOHMATRIX W : » 10,W, 10,NS *NS, A > !♦* ! 

00020 CALL V«ULFF{WtVINV*NS»NS»NS»l0*10*AUXl«l0*IER) * 

00021 CALL UERTST ( IER » 6H VPULFF I 

00022 CALL VMULFF ( V INV * AUX1» NS *NS»NS* 10* 10« AUX2* 10» IERI 

00023 CALL UERTSTC IER»6HVMULFF) 

0002* CALL tran(AUX2«NS«Nj) 

00025 DO 10 I V»1 »NS 

00026 DO 10 JV*ltNS 

00027 PUNATUV, JV) — AUX2IIV» JV) 

00028 10 CONTINUE 

00029 C CALL USWFVC l AH VECTOR VECTORS ( 14«VECT0R*NS»1«*> I** 

00030 RETURN 

00031 ENO 



00001 

00002 

00003 

00004 
00C05 
00006 

00007 
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C******************* +«»***«*»**** t******.******?****************** 
C**************************************************************** 

SUBROUTINE COMO I V< Ai,B 1, A2 ,02, XRE , XI M) 

C-Funct i on: COMPLEX DIVISION, XRE* JXIH-I Al* JB 1 >/ (A2* J82 > . 

C-IMSL routines called: UERTST, VMULFM, (USWFH ,USWFV I . 

C-Spectral Assignment routines: - 

C-Logical devices* Input Unit: - Output Unit: (51 

C- Storage Uni t Is ): - 

C-Random Access Files: - 

IF (ABS(Bl).GT.FLOAT(0).OR.AB$(a2).GT.FLOAT(On CO TO 10 
XIM-FLCAT(O) 

XRE-AI/A2 
CO TO 20 

10 XM»SCRT((AlA*2*B14*2)/(A2**2*02**2)) 

XT-ATAN(B1/A1)-ATAN(B2/A2) 

XRE-XN*COS(XT) 

XIM»XM*SIN(XT) 

20 CONTINUE 

C WRITE (5,1) A1,B1,A2,B2,XRE,XIM 

C 1 FORMAT ( IX ,F 15 *6 «2H+J*F 15 .6 , 1H/ ,F15*6«2H+J »F15«6»1H«,/ 

C 1*2 OX «F 15,6, 2H*J,F 15,6) !♦* 

RETURN 

ENO 
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C+«****** ******** ******************************************** 

C* ***************************** ************************ 

FUNCTION T( ID,VEC1,VEC2) 

C-Functlon: Evaluates T«<V1»V2> vher# VI and V2 are derminrd by 
C the choice of I0,V6C1» and VEC2 • 

C-IMSL routines called: UERTST, VMULFN, (USWFV, USWFNI. 

C-Spectral Assignment routines: - 

C-Logical devices; Input Unit: - Output Unit: (51 

C- Storage Unit(s): - 

C-Randon Access Files: - 

REAL VEC( 10 1 * VECll 10),VEC2(10I , DAD ( 10, 10), TX (1,1), 080 ( 10*10) 
REAL A ( 10 » 10 ) «B ( 10*10) »C ( 10,10) ,OAHD(10«10) 

REAL AUXl(10,L0),AUX2UO,10),AUX3< L0.10I ,AUX4I 10,101 
CQNNGN/SEN/DAD»QBO »DAHD/AUX/AUXl »AUX2 » AUX3/AAUX/AUX4 
CONHON/SYS/A,B,C»ZERO, IDGT,NS,Nl*NO 
C CALL USWFM 1 11HI dAHAT/dP J * ,11,0AHD, 10, NS, NS, 4 1 !•* 

C CALL USWFV ( 12HVEC TOR VEC1 : ,12 , VEC1,NS ,1,4 I 

C CALL USHFV (12HVECT0R VEC2: ,12, VEC2,NS«1,4 ) !♦♦ 

GO TO Cl, 2, 3), ID 

1 CALL VNULFM I0AHD»VEC2,NS*NS, 1*10,10, VEC»10*IER) 

GO TO 10 

2 CALL VHULFNI AUX4, VEC2,NS ,NS ,1, 10 ,10 » VEC,10* IER > 

GO TO 10 

3 CALL VKULFMI AUX3, VEC2, NS«NS, l, 10,10 , VEC, 10, IER 1 

10 CALL UERTST ( IER,6HVNULFH) 

C CALL USWFV ( 12HVECT0R VEC :,12,VEC , NS, 1,41 !*♦ 

CALL VHULFH (VEC1, VEC, NS,l,l, 10,10, TX,1, IER) 

CALL UERTST ( IER,6HVNULFM> 

T»TX( 1,11 

C WRITE (5,11) 10, T ! •* 

C 11 FORMAT (1X,*I0- , ,I2,5X,*T»*,F15.6) !*♦ 

RETURN 

END 
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c ««***** ******************************************* ************* 
C********************** ****** *********************************** 

SUBROUTINE TRANIAt IHt INI 

C-Function: Returns the Transpose of IA) In itself. 

C-INSL routines called: - 

C-Spectral Assignment routines: - 

C-Logtcal devices) Input Unit: - Output Unit: 

C- Storage Untt(s): - 

C-Random Access Files: - 

REAL A(10tl0)«AT( 10(10) 

00 10 I«1(IM 
00 10 J*l t I N 
ATI J,I)-A(I,J) 

10 CONTINUE 

00 20 I- If IN 
00 20 J-ldN 
AUyJI-ATdtJ) 

20 CONTINUE 

RETURN 
ENO 
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c ************************* ************** ************************ 
C*************.;***************** ************ ******************** 

SUBROUTINE SENS 

C«Functlon* Calculates dIAHATI/dP. 

C-INSL routines called: UERTSTy VNULFFy IUSWFMI . 

C-Spectral Ass ignment, rout ines: - 

C-Loglcal devices; Input Unit: - Output Unit’ 15) 

C- Storage Unit(s): - 

C-Random Access Files: - <, 

REAL DADIiOylOlyDBDilOy 10) yOAHD(lOylO) yFilOylO) yAHATUOylO) 
REAL A<l0yl0)»B<10yl0> yC(lOylO) 

C0M/10N/SEN/DA0 ♦ 080 *0AH0 / AUG/F » AHAT 

CONNON/SYS/ A yB yCy ZEROy IDGTyNSyNIyNO 

CALL VMULFF ( DBD y F yNSyNI , NSy 10y lOyOAHOy LOy IER ) 

CALL UERTST < IER yGHVNULFF ) 

C CALL USWFN I 12HtdB/dP J*IF1 : y 12y OAHOylOyNSy NSy4 ) !** 

00 25 II-lyNS 
DO 25 I <1*1 y NS 

DAHO (II y I J )*DADf 1 1 y I J ) ♦OAHOi 1 1 y I J ) 

25 CONTINUE 

C CALL USWFN I ilHI dAHAT/dP ) : yllyOAHO* 10yNSyNSy4) !** 

RETURN 
END 
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C ******** ******* ********** ********************************** 

C ******* ****************** ********************************** 

SUBROUTINE FRAC(IQ«IA»IB*RELBtXINBtID»UA«UAl?VB*VOl* 
lVOAfVQAl»FRE»FlMI 

C-Function: Expression evaluater for MODE 7. 

C-IMSL routinos called: - 

C-Spectral Assignment routines: COMDIV* nari Function T. 

C-Logical devices* Input Unit: - Output Unit: 1 5 1 

C- Storage Unit C s • * — 

C-Random Access Files: - 

REAL XX(10,10>,VA<20)'E(20)tX(20)tWJ(l0> 

REAL W< 10»10) » VINV(IO.IO) «V( 10*10) tLREI 10) .LIMC10) 

REAL A(10.10),R(10,10)*CIIC»10) 

REAL UA< LO ) « UA l ( 10 ) * V8 ( 10 ) * VB1 1 10) 

CGMMON/SYS/A»B»C» ZERO* I0GT*NS»NI*N0 

COMMON/VEC/VA,EtX,WJtW,XX*V,VINV/EIG/LRE«LIM 

FRE-FLOAT(O) 

FIM*FL0AT<0) 

IAl-IA+l 

C WRITE i 5 » 1 ) REL9»XIMB,VQA,VQA1»ID !** 

C l FORMAT ( LX» * RELB t XI MB t VQA* VQA1 * *4F15 .6 » * ID- • » 12 ) !♦* 

IF ( IA.EO. IB) GO TO 99 

IF (A8S<XIMB).GT.A8S(ZER0).0R.ABS(LIM< IA>) .GT. ABS(ZERO) ) GO TO 10 
FRE«<VQA*T< ID,VB»UA) ) / ( REL B-LRE C I A ) ) 

C WRITE (5 »2 ) FRE » 19 1 1 Ay IB !♦* 

C 2 FORMAT ( IX * • FRE* * »F15«6* 5X • • 10 * I A* I B » « 312 I !** 

GO TO 99 

10 TRR-Ti ID, VByUA) 

TCC-FLOAT(O) 

IF CABS(XIMB).GT.ABS(ZERO).AND.*BS(LIM<IA) ) .GT.A8S C ZERO ) ) TCC- 
1T ( ID* VB1 *UAl ) 

TCR-FLOATIO) 

IF (ABS(XIMB).GT.ABS(ZERO)) TCR-TI ID* VB1*UA I 
TRC-FLQAT(O) 

IF (ABSIL IM( IA) ) . G T. A3 S ( ZERO) ) TRC-TI ID* VB *UA1 ) 
A1«(TRR-TCC)*VQA-(TCR*TRC)*VQA1 
Bl*< TCR«-TRC)*VQA*ITRR-TCC)*VQAl 
A2-RELB-LREI IA) 

B2-L I M ( IA)— XIMB 

CALL CCMOIV (Al«Bl*A2*B2*FRE«FIM) 

99 RETURN 
END 
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